【问题标题】:Export SYS Info from a VBS to Excel将 SYS 信息从 VBS 导出到 Excel
【发布时间】:2023-03-11 05:17:01
【问题描述】:

只是想知道是否有人可以帮助我实现这一目标。我有 2 个 VBS 脚本,当我指定机器名称或 IP 地址时,它们可以显示 PC Sysinfo 和监控信息。但是我想修改它,以便我可以运行 1 个 VBS 来获取两个信息(PC Sysinfo + 监视器信息),然后导出到 MS Excel 文件。目前您只能输入 1 个 PC 名称或 IP 地址。有没有办法修改,以便我可以批处理以获取域中的所有 PC 信息?

PC Sysinfo VBS 脚本

        strComputer = inputbox("Type the name of the computer with out \\ or an IP address to find out the service tag")
    rem strComputer = "10.12.102.109"
    if strComputer = "" then wscript.quit

    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

    Set colSMBIOS = objWMIService.ExecQuery ("Select * from Win32_SystemEnclosure")
    For Each objSMBIOS in colSMBIOS
    rem    Wscript.Echo "Service tag (serial number): " & objSMBIOS.SerialNumber
         strSN = objSMBIOS.SerialNumber
    Next

    rem strComputer = "."

    Set objSWbemServices = GetObject("winmgmts:\\" & strComputer)
    Set colSWbemObjectSet = _
        objSWbemServices.InstancesOf("Win32_LogicalMemoryConfiguration")

    For Each objSWbemObject In colSWbemObjectSet
    rem    Wscript.Echo "Total Physical Memory (kb): " & _
    rem        objSWbemObject.TotalPhysicalMemory
            strMemory = objSWbemObject.TotalPhysicalMemory
    Next



    Set colOperatingSystems = objSWbemServices.InstancesOf("Win32_OperatingSystem")

    For Each objOperatingSystem In colOperatingSystems
       OSName = objOperatingSystem.Name 
       OSVersion = objOperatingSystem.Version        
       OSSevPac= objOperatingSystem.ServicePackMajorVersion & _
            "." & objOperatingSystem.ServicePackMinorVersion      
    Next




    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colSettings = objWMIService.ExecQuery _
        ("SELECT * FROM Win32_OperatingSystem")
    For Each objOperatingSystem in colSettings
        AvaMem =   objOperatingSystem.FreePhysicalMemory
    Next
    Set colSettings = objWMIService.ExecQuery _
        ("SELECT * FROM Win32_ComputerSystem")
    For Each objComputer in colSettings
        CmpNam = objComputer.Name
        CmpMnf = objComputer.Manufacturer
        CmpMdl = objComputer.Model
    Next
    Set colSettings = objWMIService.ExecQuery _
        ("SELECT * FROM Win32_Processor")
    For Each objProcessor in colSettings
        PrcDsc =  objProcessor.Description
    Next
    Set colSettings = objWMIService.ExecQuery _
        ("SELECT * FROM Win32_BIOS")
    For Each objBIOS in colSettings
        BIOS = objBIOS.Version
    Next

    Rem --------------------

Set colAdapters = objWMIService.ExecQuery _
("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")


For Each oAdapter in colAdapters
   For Each sIPAddress in oAdapter.IPAddress
    If sIPAddress <>  "0.0.0.0"  Then 
        IP = sIPAddress 
        MAC = oAdapter.MACAddress
        EXIT FOR
    End If
   Next
Next

Rem

rem ____________________
MsgBox  "Hardware" & vbCrLf & _
    "   Service Tag:        " & strSN & vbCrLf & _
    "   Total Memory(KB):       " & strMemory & vbCrLf  & _
        "   Available Memory(KB):   " & AvaMem & vbCrLf & _
        "   Computer Name:      "  & CmpNam & vbCrLf  & _
        "   System Manufacturer:    " & CmpMnf & vbCrLf  & _
        "   System Model:       " & CmpMdl & vbCrLf  & _
        "   Processor:      " & PrcDsc & vbCrLf  & _
    "   BIOS Version:       " & BIOS & vbCrLf  & vbCrLf & _
    "OS"  & vbCrLf & _      
    "   OS Name:                " & OSName   & vbCrLf & _
        "   Version:                " & OSVersion         & vbCrLf & _
        "   Service Pack:           " & OSSevPac & vbCrLf  & vbCrLf &_
    "   Network"  & vbCrLf & _      
    "   IP Address:     " & IP & vbcrlf & _
    "   MAC:            " & MAC _
 ,0, strComputer &  "  - System Information" 
Rem

监控 VBS 脚本

'
'==========================================================================

Option Explicit
Dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
Dim strComputer, message

Dim intMonitorCount
Dim oRegistry, sBaseKey, sBaseKey2, sBaseKey3, skey, skey2, skey3
Dim sValue
dim i, iRC, iRC2, iRC3
Dim arSubKeys, arSubKeys2, arSubKeys3, arrintEDID
Dim strRawEDID
Dim ByteValue, strSerFind, strMdlFind
Dim intSerFoundAt, intMdlFoundAt, findit
Dim tmp, tmpser, tmpmdl, tmpctr
Dim batch, bHeader
batch = False

If WScript.Arguments.Count = 1 Then
    strComputer = WScript.Arguments(0)
    batch = True
Else
    strComputer = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
    strComputer = InputBox("Check Monitor info for what PC","PC Name?",strComputer)
End If 

If strcomputer = "" Then WScript.Quit
strComputer = UCase(strComputer)

If batch Then 
    Dim fso,logfile, appendout
    logfile = wshShell.ExpandEnvironmentStrings("%userprofile%") & "\desktop\MonitorInfo.csv"

    'setup Log
    Const ForAppend = 8
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(logfile) Then bHeader = True
    set appendout = fso.OpenTextFile(logfile, ForAppend, True)

    If bHeader Then 
        appendout.writeline "Computer,Model,Serial #,Vendor ID,Manufacture Date,Messages"
    End If 
End If 

Dim strarrRawEDID()
intMonitorCount=0
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
'get a handle to the WMI registry object
On Error Resume Next
Set oRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "/root/default:StdRegProv")

If Err <> 0 Then
    If batch Then 
        EchoAndLog strComputer & ",,,,," & Err.Description
    Else
        MsgBox "Failed. " & Err.Description,vbCritical + vbOKOnly,strComputer
        WScript.Quit
    End If 
End If 


sBaseKey = "SYSTEM\CurrentControlSet\Enum\DISPLAY\"
'enumerate all the keys HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\
iRC = oRegistry.EnumKey(HKLM, sBaseKey, arSubKeys)
For Each sKey In arSubKeys
     'we are now in the registry at the level of:
     'HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\<VESA_Monitor_ID\
     'we need to dive in one more level and check the data of the "HardwareID" value
    sBaseKey2 = sBaseKey & sKey & "\"
    iRC2 = oRegistry.EnumKey(HKLM, sBaseKey2, arSubKeys2)
    For Each sKey2 In arSubKeys2
          'now we are at the level of:
          'HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\<VESA_Monitor_ID\<PNP_ID>\
          'so we can check the "HardwareID" value
        oRegistry.GetMultiStringValue HKLM, sBaseKey2 & sKey2 & "\", "HardwareID", sValue
        for tmpctr=0 to ubound(svalue)
            If lcase(left(svalue(tmpctr),8))="monitor\" then
                    'If it is a monitor we will check for the existance of a control subkey
                    'that way we know it is an active monitor
                    sBaseKey3 = sBaseKey2 & sKey2 & "\"
                    iRC3 = oRegistry.EnumKey(HKLM, sBaseKey3, arSubKeys3)
                    For Each sKey3 In arSubKeys3
                    'Kaplan edit
                    strRawEDID = ""
                         If skey3="Control" Then
                              'If the Control sub-key exists then we should read the edid info
                              oRegistry.GetBinaryValue HKLM, sbasekey3 & "Device Parameters\", "EDID", arrintEDID
                           If vartype(arrintedid) <> 8204 then 'and If we don't find it...
                                   strRawEDID="EDID Not Available" 'store an "unavailable message
                              else
                                   for each bytevalue in arrintedid 'otherwise conver the byte array from the registry into a string (for easier processing later)
                                        strRawEDID=strRawEDID & chr(bytevalue)
                                   Next
                              End If
                              'now take the string and store it in an array, that way we can support multiple monitors
                              redim preserve strarrRawEDID(intMonitorCount)
                              strarrRawEDID(intMonitorCount)=strRawEDID
                              intMonitorCount=intMonitorCount+1
                          End If
                    Next
            End If
        Next    
    Next     
Next
'*****************************************************************************************
'now the EDID info for each active monitor is stored in an array of strings called strarrRawEDID
'so we can process it to get the good stuff out of it which we will store in a 5 dimensional array
'called arrMonitorInfo, the dimensions are as follows:
'0=VESA Mfg ID, 1=VESA Device ID, 2=MFG Date (M/YYYY),3=Serial Num (If available),4=Model Descriptor
'5=EDID Version
'*****************************************************************************************
On Error Resume Next 
dim arrMonitorInfo()
redim arrMonitorInfo(intMonitorCount-1,5)
dim location(3)
for tmpctr=0 to intMonitorCount-1
     If strarrRawEDID(tmpctr) <> "EDID Not Available" then
          '*********************************************************************
          'first get the model and serial numbers from the vesa descriptor
          'blocks in the edid.  the model number is required to be present
          'according to the spec. (v1.2 and beyond)but serial number is not
          'required.  There are 4 descriptor blocks in edid at offset locations
          '&H36 &H48 &H5a and &H6c each block is 18 bytes long
          '*********************************************************************
          location(0)=mid(strarrRawEDID(tmpctr),&H36+1,18)
          location(1)=mid(strarrRawEDID(tmpctr),&H48+1,18)
          location(2)=mid(strarrRawEDID(tmpctr),&H5a+1,18)
          location(3)=mid(strarrRawEDID(tmpctr),&H6c+1,18)

          'you can tell If the location contains a serial number If it starts with &H00 00 00 ff
          strSerFind=chr(&H00) & chr(&H00) & chr(&H00) & chr(&Hff)
          'or a model description If it starts with &H00 00 00 fc
          strMdlFind=chr(&H00) & chr(&H00) & chr(&H00) & chr(&Hfc)

          intSerFoundAt=-1
          intMdlFoundAt=-1
          for findit = 0 to 3
               If instr(location(findit),strSerFind)>0 then
                    intSerFoundAt=findit
               End If
               If instr(location(findit),strMdlFind)>0 then
                    intMdlFoundAt=findit
               End If
          Next

          'If a location containing a serial number block was found then store it
          If intSerFoundAt<>-1 then
               tmp=right(location(intSerFoundAt),14)
               If instr(tmp,chr(&H0a))>0 then
                    tmpser=trim(left(tmp,instr(tmp,chr(&H0a))-1))
               Else
                    tmpser=trim(tmp)
               End If
               'although it is not part of the edid spec it seems as though the
               'serial number will frequently be preceeded by &H00, this
               'compensates for that
               If left(tmpser,1)=chr(0) then tmpser=right(tmpser,len(tmpser)-1)
          else
               tmpser="Not Found"
          End If

          'If a location containing a model number block was found then store it
          If intMdlFoundAt<>-1 then
               tmp=right(location(intMdlFoundAt),14)
               If instr(tmp,chr(&H0a))>0 then
                    tmpmdl=trim(left(tmp,instr(tmp,chr(&H0a))-1))
               else
                    tmpmdl=trim(tmp)
               End If
               'although it is not part of the edid spec it seems as though the
               'serial number will frequently be preceeded by &H00, this
               'compensates for that
               If left(tmpmdl,1)=chr(0) then tmpmdl=right(tmpmdl,len(tmpmdl)-1)
          else
               tmpmdl="Not Found"
          End If

          '**************************************************************
          'Next get the mfg date
          '**************************************************************
          Dim tmpmfgweek,tmpmfgyear,tmpmdt
          'the week of manufacture is stored at EDID offset &H10
          tmpmfgweek=asc(mid(strarrRawEDID(tmpctr),&H10+1,1))

          'the year of manufacture is stored at EDID offset &H11
          'and is the current year -1990
          tmpmfgyear=(asc(mid(strarrRawEDID(tmpctr),&H11+1,1)))+1990

          'store it in month/year format          
          tmpmdt=month(dateadd("ww",tmpmfgweek,datevalue("1/1/" & tmpmfgyear))) & "/" & tmpmfgyear

          '**************************************************************
          'Next get the edid version
          '**************************************************************
          'the version is at EDID offset &H12
          Dim tmpEDIDMajorVer, tmpEDIDRev, tmpVer
          tmpEDIDMajorVer=asc(mid(strarrRawEDID(tmpctr),&H12+1,1))

          'the revision level is at EDID offset &H13
          tmpEDIDRev=asc(mid(strarrRawEDID(tmpctr),&H13+1,1))

          'store it in month/year format          
          tmpver=chr(48+tmpEDIDMajorVer) & "." & chr(48+tmpEDIDRev)

          '**************************************************************
          'Next get the mfg id
          '**************************************************************
          'the mfg id is 2 bytes starting at EDID offset &H08
          'the id is three characters long.  using 5 bits to represent
          'each character.  the bits are used so that 1=A 2=B etc..
          '
          'get the data
          Dim tmpEDIDMfg, tmpMfg
          dim Char1, Char2, Char3
          Dim Byte1, Byte2
          tmpEDIDMfg=mid(strarrRawEDID(tmpctr),&H08+1,2)          
          Char1=0 : Char2=0 : Char3=0 
          Byte1=asc(left(tmpEDIDMfg,1)) 'get the first half of the string 
          Byte2=asc(right(tmpEDIDMfg,1)) 'get the first half of the string
          'now shift the bits
          'shift the 64 bit to the 16 bit
          If (Byte1 and 64) > 0 then Char1=Char1+16 
          'shift the 32 bit to the 8 bit
          If (Byte1 and 32) > 0 then Char1=Char1+8 
          'etc....
          If (Byte1 and 16) > 0 then Char1=Char1+4 
          If (Byte1 and 8) > 0 then Char1=Char1+2 
          If (Byte1 and 4) > 0 then Char1=Char1+1 

          'the 2nd character uses the 2 bit and the 1 bit of the 1st byte
          If (Byte1 and 2) > 0 then Char2=Char2+16 
          If (Byte1 and 1) > 0 then Char2=Char2+8 
          'and the 128,64 and 32 bits of the 2nd byte
          If (Byte2 and 128) > 0 then Char2=Char2+4 
          If (Byte2 and 64) > 0 then Char2=Char2+2 
          If (Byte2 and 32) > 0 then Char2=Char2+1 

          'the bits for the 3rd character don't need shifting
          'we can use them as they are
          Char3=Char3+(Byte2 and 16) 
          Char3=Char3+(Byte2 and 8) 
          Char3=Char3+(Byte2 and 4) 
          Char3=Char3+(Byte2 and 2) 
          Char3=Char3+(Byte2 and 1) 
          tmpmfg=chr(Char1+64) & chr(Char2+64) & chr(Char3+64)

          '**************************************************************
          'Next get the device id
          '**************************************************************
          'the device id is 2bytes starting at EDID offset &H0a
          'the bytes are in reverse order.
          'this code is not text.  it is just a 2 byte code assigned
          'by the manufacturer.  they should be unique to a model
          Dim tmpEDIDDev1, tmpEDIDDev2, tmpDev

          tmpEDIDDev1=hex(asc(mid(strarrRawEDID(tmpctr),&H0a+1,1)))
          tmpEDIDDev2=hex(asc(mid(strarrRawEDID(tmpctr),&H0b+1,1)))
          If len(tmpEDIDDev1)=1 then tmpEDIDDev1="0" & tmpEDIDDev1
          If len(tmpEDIDDev2)=1 then tmpEDIDDev2="0" & tmpEDIDDev2
          tmpdev=tmpEDIDDev2 & tmpEDIDDev1

          '**************************************************************
          'finally store all the values into the array
          '**************************************************************
          'Kaplan adds code to avoid duplication...

          If Not InArray(tmpser,arrMonitorInfo,3) Then 
              arrMonitorInfo(tmpctr,0)=tmpmfg
              arrMonitorInfo(tmpctr,1)=tmpdev
              arrMonitorInfo(tmpctr,2)=tmpmdt
              arrMonitorInfo(tmpctr,3)=tmpser
              arrMonitorInfo(tmpctr,4)=tmpmdl
              arrMonitorInfo(tmpctr,5)=tmpVer
          End If 
     End If
Next

'For now just a simple screen print will suffice for output.
'But you could take this output and write it to a database or a file
'and in that way use it for asset management.
i = 0
for tmpctr = 0 to intMonitorCount-1
     If arrMonitorInfo(tmpctr,1) <> "" And arrMonitorInfo(tmpctr,0) <> "PNP" Then 
         If batch Then
             EchoAndLog strComputer & "," & arrMonitorInfo(tmpctr,4) & "," & _
             arrMonitorInfo(tmpctr,3)& "," & arrMonitorInfo(tmpctr,0) & "," & _
             arrMonitorInfo(tmpctr,2)
          Else
             message =  message & "Monitor " & chr(i+65) & ")" & VbCrLf & _
             "Model Name: " & arrMonitorInfo(tmpctr,4) & VbCrLf & _
             "Serial Number: " & arrMonitorInfo(tmpctr,3)& VbCrLf & _
             "VESA Manufacturer ID: " & arrMonitorInfo(tmpctr,0) & VbCrLf & _
             "Manufacture Date: " & arrMonitorInfo(tmpctr,2) & VbCrLf & VbCrLf 
             'wscript.echo ".........." & "Device ID: " & arrMonitorInfo(tmpctr,1)
             'wscript.echo ".........." & "EDID Version: " & arrMonitorInfo(tmpctr,5)
                 i = i + 1
         End If 
     End If 
Next

If not batch Then
    MsgBox message, vbInformation + vbOKOnly,strComputer & " Monitor Info"
End If 

Function InArray(strValue,List,Col)
    Dim i
    For i = 0 to UBound(List)
        If List(i,col) = cstr(strValue) Then
            InArray = True
            Exit Function
        End If
    Next
    InArray = False 
End Function

Sub EchoAndLog (message)
'Echo output and write to log
    Wscript.Echo message
    AppendOut.WriteLine message
End Sub

【问题讨论】:

    标签: excel vbscript


    【解决方案1】:

    您可以使用LDAP 使用类似于此的代码遍历域中的所有计算机:

    Const ADS_SCOPE_SUBTREE = 2
    
    Set conn = CreateObject("ADODB.Connection")
    Set cmd =   CreateObject("ADODB.Command")
    conn.Provider = "ADsDSOObject"
    conn.Open "Active Directory Provider"
    Set cmd.ActiveConnection = conn
    
    cmd.Properties("Page Size") = 1000
    cmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
    
    cmd.CommandText = "SELECT Name FROM 'LDAP://dc=test,dc=com' WHERE objectCategory='computer'"
    Set rec = cmd.Execute
    
    rec.MoveFirst
    Do Until rec.EOF
        Wscript.Echo rec.Fields("Name").Value
        rec.MoveNext
    Loop
    

    您必须将LDAP://dc=test,dc=com 更改为适合您的binding string

    然后,如果您将这 2 个脚本中的当前代码重构为至少在几个脚本中(尽管我建议尝试更改您的代码,以便您通过单独的一段代码检索到的每个单独的值也将在它自己的函数中,并让这些函数根据需要由procedures 的过程调用),您可以只调用这些过程而不是执行Wscript.Echo rec.Fields("Name").Value

    要创建 Excel 文件,您有多种选择,最简单的一种可能是使用 FSO (FileSystemObject) 将值写入 CSV 文件,而不是在消息框中显示,这很容易由 Excel 打开。
    否则,如果你想做一些更高级的事情,你可以自动化 Excel 来完成它,有关详细信息,请参阅以下文章:How to automate Excel from a client-side VBScript

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2011-01-28
      • 1970-01-01
      相关资源
      最近更新 更多