Dim objNetwork
Dim objExcel
Dim objWorkBook
Set objExcel = CreateObject("EXCEL.APPLICATION")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Add()
objworkbook.ActiveSheet.Range("A1").value = "DisplayComputername"
Set objNetwork = CreateObject("WScript.NetWork")

Dim strComputer
strComputer = objNetwork.ComputerName
Msg strComputer
Set objNetwork = Nothing

Recommended Answers

All 3 Replies

What does the error message say?:?:

Dim objNetwork
Dim objExcel
Dim objWorkBook
Set objExcel = CreateObject("EXCEL.APPLICATION")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Add()
objworkbook.ActiveSheet.Range("A1").value = "DisplayComputername"
Set objNetwork = CreateObject("WScript.NetWork")

Dim strComputer
strComputer = objNetwork.ComputerName
Msg strComputer
Set objNetwork = Nothing

Member Avatar for iamthwee

I assume you've added the relevant com library

Thank you! I find the problem so is somebody whant to look this is the code. Is full find what software are in the comp and save on Excel .
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
objWorkbook.SaveAs ("C:\TEST.xls")

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.