Tech Support Guy banner
Cancel

VB scripting question

5604 Views 34 Replies 5 Participants Last post by  IBGhost, 
C
Hello, Hopefully this will be pretty easy. I found some script on Microsoft site that will help gather computer infomation. What i would like to do is have the scripts put the information into a excel spreadsheet or something. Right now, the scripts are echoing the info on the screen. Which is fine but i need to run this on several computers and need to be able to view the info later. Any help would be great. thanks
Save
Like
Status
Not open for further replies.
1 - 13 of 35 Posts
Rollin_Again
Can you post your existing script for us to see?

Rollin
Save
Like
Rollin_Again
Do you need to have the script create the Excel workbook and will the workbook already exist on each machine?

Rollin
Save
Like
Rollin_Again
Try the modified code below. I did not include code to save the workbook so make sure to manually save to a location of your choice.

Code: 
Dim objExcel 
Dim objWorkBook 
Dim vLastRow

Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
strComputer = "."
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
strEntry1a = "DisplayName"
strEntry1b = "QuietDisplayName"
strEntry2 = "InstallDate"
strEntry3 = "VersionMajor"
strEntry4 = "VersionMinor"
strEntry5 = "EstimatedSize"

Set objExcel = CreateObject("EXCEL.APPLICATION")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Add()
objWorkbook.ActiveSheet.Range("A1").Value =  "DisplayName"
objWorkbook.ActiveSheet.Range("B1").Value = "InstallDate"
objWorkbook.ActiveSheet.Range("C1").Value = "VersionMajor"
objWorkbook.ActiveSheet.Range("D1").Value = "EstimatedSize"

vLastRow = objWorkbook.Activesheet.UsedRange.Rows.Count + 1

Set objReg = GetObject("winmgmts://" & strComputer & _
"/root/default:StdRegProv")
objReg.EnumKey HKLM, strKey, arrSubkeys
For Each strSubkey In arrSubkeys
intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey, _
strEntry1a, strValue1)
If intRet1 <> 0 Then
objReg.GetStringValue HKLM, strKey & strSubkey, _
strEntry1b, strValue1
End If
If strValue1 <> "" Then
objWorkbook.ActiveSheet.Range("A" & vLastRow).Value =  strValue1
End If
objReg.GetStringValue HKLM, strKey & strSubkey, _
strEntry2, strValue2
If strValue2 <> "" Then
objWorkbook.ActiveSheet.Range("B" & vLastRow).Value =  strValue2
End If
objReg.GetDWORDValue HKLM, strKey & strSubkey, _
strEntry3, intValue3
objReg.GetDWORDValue HKLM, strKey & strSubkey, _
strEntry4, intValue4
If intValue3 <> "" Then
objWorkbook.ActiveSheet.Range("C" & vLastRow).Value =   intValue4
End If
objReg.GetDWORDValue HKLM, strKey & strSubkey, _
strEntry5, intValue5
If intValue5 <> "" Then
objWorkbook.ActiveSheet.Range("D" & vLastRow).Value =   Round(intValue5/1024, 3) & " megabytes"
End If

vLastRow = objWorkbook.Activesheet.UsedRange.Rows.Count + 1
Next
Regards,
Rollin
See less See more
Save
Like
Rollin_Again
Just add the following line to the end of the code and change the path to reflect the true save destination. Did you test the code to see if it does what you want?

Code: 
objWorkbook.SaveAs ("C:\TEST.xls")
Rollin
Save
Like
Rollin_Again
If you want to speed up the code processing and suppress the line by line updating you have two options. Both ways should reduce the processing time from about 20-30 seconds to about 5.

Keep the Excel object hidden and do not display until the code is finished processing. So basically take the line objExcel.Visible = True and move it outside of your "For/Next" loop.

Code: 
Set objExcel = CreateObject("EXCEL.APPLICATION")

'code
'code

Next
objExcel.Visible = True
You can also suppress Screen Updating by adding the following line of code just after the Excel object is created objExcel.ScreenUpdating = False

After the code is finished processing and you have exited the "For/Next" loop just turn the updating back on using objExcel.ScreenUpdating = True

Code: 
Set objExcel = CreateObject("EXCEL.APPLICATION")
objExcel.Visible = True
objExcel.ScreenUpdating = False

'code
'code

Next
objExcel.ScreenUpdating = True
Regards,
Rollin
See less See more
Save
Like
Rollin_Again
Copy and paste the code below into a blank module and then run the macro called function named "GetName"

You can also get the name from another sub by calling the function called funcCompName

Code: 
Private Declare Function apiGetComputerName Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function funcCompName() As String

    Dim lngLen As Long, lngX As Long
    Dim strCompName As String
    lngLen = 16
    strCompName = String$(lngLen, 0)
    lngX = apiGetComputerName(strCompName, lngLen)
    If lngX <> 0 Then
        funcCompName = Left$(strCompName, lngLen)
    End If
End Function


Public Sub GetName()

strCompName = funcCompName
MsgBox (strCompName)

End Sub
Regards,
Rollin
See less See more
Save
Like
Rollin_Again
Copy and paste the code below at the very top of your existing code module

Code: 
Private Declare Function apiGetComputerName Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function funcCompName() As String

    Dim lngLen As Long, lngX As Long
    Dim strCompName As String
    lngLen = 16
    strCompName = String$(lngLen, 0)
    lngX = apiGetComputerName(strCompName, lngLen)
    If lngX <> 0 Then
        funcCompName = Left$(strCompName, lngLen)
    End If
End Function
After pasting the above code into your module your function will be declared and defined and you can call it from anywhere else in your code by using the two lines below. If you continue to have problems post your workbook or document and I'll help you.

Code: 
strCompName = funcCompName
MsgBox (strCompName)
Regards,
Rollin
See less See more
Save
Like
Rollin_Again
I'm sorry....the code I provided you earlier is for VBA. I didn't realize you needed the code for a VBS script. Just add the code below. The computer name will be assigned to the variable strInfo. Just change form a Messagebox to whatever action you want to take.

Code: 
Dim objNetwork

Set objNetwork = CreateObject("WScript.NetWork") 
	
Dim strComputer
strComputer = objNetwork.ComputerName 
         
MsgBox strComputer
	
Set objNetwork = Nothing
I'm not exactly sure what you want saved to the network drive. Do you want this info saved into a text file or Excel workbook and then saved on the network? If so, the code needs to be modified to create the destination file and then save to your location.

Regards,
Rollin
See less See more
Save
Like
Rollin_Again
So how does the computer name come into play? What is the save path you want the Excel file written to?

Regards,
Rollin
Save
Like
Rollin_Again
Copy and paste into a text file and re-name with .vbs extension.

This will create the Excel workbook and save to the E:\ drive as: ComputerName.xls

Cell A1 of the Excel workbook will also contain the computer name.

Code: 
Dim objExcel 
Dim objWorkBook 
Dim vLastRow
Dim objNetwork
Dim strComputerName

Set objNetwork = CreateObject("WScript.NetWork") 
strComputerName = objNetwork.ComputerName 

Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
strComputer = "."
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
strEntry1a = "DisplayName"
strEntry1b = "QuietDisplayName"
strEntry2 = "InstallDate"
strEntry3 = "VersionMajor"
strEntry4 = "VersionMinor"
strEntry5 = "EstimatedSize"

Set objExcel = CreateObject("EXCEL.APPLICATION")
Set objWorkbook = objExcel.Workbooks.Add()
objWorkbook.activesheet.Range("A1").value = strComputerName
objWorkbook.ActiveSheet.Range("A2").Value =  "DisplayName"
objWorkbook.ActiveSheet.Range("B2").Value = "InstallDate"
objWorkbook.ActiveSheet.Range("C2").Value = "VersionMajor"
objWorkbook.ActiveSheet.Range("D2").Value = "EstimatedSize"

vLastRow = objWorkbook.Activesheet.UsedRange.Rows.Count + 1

Set objReg = GetObject("winmgmts://" & strComputer & _
"/root/default:StdRegProv")
objReg.EnumKey HKLM, strKey, arrSubkeys
For Each strSubkey In arrSubkeys
intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey, _
strEntry1a, strValue1)
If intRet1 <> 0 Then
objReg.GetStringValue HKLM, strKey & strSubkey, _
strEntry1b, strValue1
End If
If strValue1 <> "" Then
objWorkbook.ActiveSheet.Range("A" & vLastRow).Value =  strValue1
End If
objReg.GetStringValue HKLM, strKey & strSubkey, _
strEntry2, strValue2
If strValue2 <> "" Then
objWorkbook.ActiveSheet.Range("B" & vLastRow).Value =  strValue2
End If
objReg.GetDWORDValue HKLM, strKey & strSubkey, _
strEntry3, intValue3
objReg.GetDWORDValue HKLM, strKey & strSubkey, _
strEntry4, intValue4
If intValue3 <> "" Then
objWorkbook.ActiveSheet.Range("C" & vLastRow).Value =   intValue4
End If
objReg.GetDWORDValue HKLM, strKey & strSubkey, _
strEntry5, intValue5
If intValue5 <> "" Then
objWorkbook.ActiveSheet.Range("D" & vLastRow).Value =   Round(intValue5/1024, 3) & " megabytes"
End If

vLastRow = objWorkbook.Activesheet.UsedRange.Rows.Count + 1
Next


vPath = "E:\" & strComputerName & ".xls"

objWorkbook.SaveAs(vPath)
objWorkbook.Close

Set objExcel = Nothing
Set objWorkbook = Nothing
Set objNetwork = Nothing
Set objReg = Nothing  

Msgbox("Complete")
Regards,
Rollin
See less See more
Save
Like
Rollin_Again
Sorry.....When I copies and pasted the code a few extra spaces got included. I fixed the code above and also included the file as an attachement to this post. Download the attached text file and manually rename the .txt extension to .vbs and then run it.

Regards,
Rollin

Attachments

Save
Like
Rollin_Again
Does it give an error? Have you checked to make sure there is no anti-virus or anti-spyware running that may be preventing the script from running?

Regards,
Rollin
Save
Like
Rollin_Again
Go into the task manager and kill Excel.exe from the list of running processes and try again. Also make sure the E:\ drive is mapped on that PC.

Regards,
Rollin
Save
Like
1 - 13 of 35 Posts
Status
Not open for further replies.
Tech Support Guy
A forum community dedicated to tech experts and enthusiasts. Come join the discussion about articles, computer security, Mac, Microsoft, Linux, hardware, networking, gaming, reviews, accessories, and more!
Full Forum Listing
Explore Our Forums
Hardware Virus & Other Malware Removal Off Topic Lounge Thread Games & Discussion Networking
Top