VB scripting question

clmowers · Jan 2, 2007

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

saikee · Jan 2, 2007

What is stopping you from "cut and paste" the script s (even directly off the Internet screen) into the VB editor of a Excel spread sheet?

Rollin_Again · Jan 3, 2007

Can you post your existing script for us to see?

Rollin

clmowers · Jan 3, 2007

Code:

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 objReg = GetObject("winmgmts://" & strComputer & _
 "/root/default:StdRegProv")
objReg.EnumKey HKLM, strKey, arrSubkeys
WScript.Echo "Installed Applications" & VbCrLf
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
    WScript.Echo VbCrLf & "Display Name: " & strValue1
  End If
  objReg.GetStringValue HKLM, strKey & strSubkey, _
   strEntry2, strValue2
  If strValue2 <> "" Then
    WScript.Echo "Install Date: " & strValue2
  End If
  objReg.GetDWORDValue HKLM, strKey & strSubkey, _
   strEntry3, intValue3
  objReg.GetDWORDValue HKLM, strKey & strSubkey, _
   strEntry4, intValue4
  If intValue3 <> "" Then
     WScript.Echo "Version: " & intValue3 & "." & intValue4
  End If
  objReg.GetDWORDValue HKLM, strKey & strSubkey, _
   strEntry5, intValue5
  If intValue5 <> "" Then
    WScript.Echo "Estimated Size: " & Round(intValue5/1024, 3) & " megabytes"
  End If
Next
[code]

Rollin_Again · Jan 3, 2007

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

Rollin

clmowers · Jan 3, 2007

Well i would like it to create the workbook if possible

Rollin_Again · Jan 3, 2007

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

clmowers · Jan 4, 2007

What would that code be to save it automaticlly?

Rollin_Again · Jan 4, 2007

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

clmowers · Jan 5, 2007

Yes, i did test the code and it works great. Thanks so much

clmowers · Jan 5, 2007

Very cool. Thanks. The code works perfect. I think i have enough info to go by to modify the others. Thanks

MMJ · Jan 11, 2007

Very nice!

What is the copyright on this script?

clmowers · Jan 11, 2007

Im not sure if there is one. It freely avaible on microsofts site

MMJ · Jan 12, 2007

Is there a way to make the excel file fill up immediately?

Also where is this script on MS's site?

clmowers · Jan 13, 2007

This script does fill the info immediately. Unless im not sure what you mean by that

http://www.microsoft.com/technet/scriptcenter/default.mspx

Just do some clicking here. but this is where i found the script above. there are lot of scripts up there that can be usefull vor any system admin or tech

MMJ · Jan 13, 2007

No, the script fills up one line at a time for me.

So the excel file takes like 30 seconds to fill all the way.

Thanks for the link.

clmowers · Jan 16, 2007

Oh i see what you are saying. Im not sure if there is a way. But i see what you are saying now.
And your welcome for the link

Rollin_Again · Jan 16, 2007

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

IBGhost · Apr 30, 2007

How can you change this code to give you the computer name too?

Rollin_Again · Apr 30, 2007

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

VB scripting question

Top Contributors this Month