Tech Support Guy banner

VB scripting question

5607 Views 34 Replies 5 Participants Last post by  IBGhost
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
Status
Not open for further replies.
21 - 35 of 35 Posts
Ok ! can you explain a little more how do add your code to my code?
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
This is my 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

I will like when I run the script to give the computername and to save on the network drive.
Thank for help me!
See less See more
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
yes when I run the code to give me the output in excel and to be save on the network drive.
So how does the computer name come into play? What is the save path you want the Excel file written to?

Regards,
Rollin
What i am trying to do is when I run the script to give the the name or asset number of the computer and the software on excel sheet on the E drive, which is a network drive.
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
I still have problem when I run the programm it give syntax error,line58 and char79
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

Thank you! it work fine now. But I want to ask you one more question when I try to put to another comp is not working?
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
The file name or path name does not exist
The file you are trying to open is being used by another prog.Close the document in the other program and try again
The name of the workbook yo are trying to save is the same of another doc that is read-only
code;800A03EC
source: Microsoft Excel
line 67
char1
this is the error
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
21 - 35 of 35 Posts
Status
Not open for further replies.
Top