AssetScan - Remotely build an Asset inventory of PCs

• Download source - 5.20 Kb

Introduction

This script will remotely query and gather information from PCs in a network using IP & WMI, then output the results into an Excel spreadsheet.

Background

The app was created to build an inventory of assets within a network. It gathers common information from each PC which is useful for asset management and tracking during hardware upgrades, moves, add-ons etc.

Currently gathers the below information:

IP Address, Hostname, Domain Role, Make, Model, Serial Number, RAM, Operating System, Service Pack BIOS Revision, Processor Type, Processor Speed, Logged in user, Subnet Mask, Default Gateway, MAC Address, Date Installed, NIC #1 Model, NIC #2 Model, NIC #3 Model, NIC #4 Model, NIC #5 Model.

Using the code

Simply copy the code below and save it in a .vbs file, then answer the prompts and watch the output appear in the Excel spreadsheet. That's it!

If you update, change or have suggestions on the code, please share it with me by email. :)

The code needed:

'***********************************************************
'AssetScan.vbs - Query PC's on your network with WMI and log
'the responses into an excel spreadsheet.
'
'© Sean Kelly - skelly@engineer.com
' rev 12 April 2005
' 
' works with Windows NT, 2K, XP


On Error Resume Next

'***** DECLARATIONS***************************** 
CONST wbemFlagReturnImmediately = &h10
CONST wbemFlagForwardOnly = &h20
CONST ForReading = 1 
CONST ForWriting = 2 
CONST DEV_ID = 0 
CONST FSYS = 1 
CONST DSIZE = 2 
CONST FSPACE = 3 
CONST USPACE = 4 
CONST TITLE = "AssetScanLite" 

Dim fso, f, fsox, fx, objXL, wmiPath, strNoPing, strMBProduct
Dim computerIndex, wscr, adsi, intbutton, strStart, Cshell, strNoConnect
Dim inputFile, outputFile, objKill, strAction, strComplete, strManufact
Dim strPC, intRow, strFilter, RowNum, strCompName, strVideo, strFSB
Dim strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE, strSD 
Dim strRAM, strVir, strPage, strOS, strSP, strProdID, strStatic, strUser 
Dim strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed, strHostName
Dim pathlength, Scriptpath
Dim strDomain, strRole, strMake, strModel, strSerial, _
    strBIOSrev, strNICmodel(4), strDateInstalled

outputFile = "IP_table.txt"

set fsox = CreateObject("Scripting.FileSystemObject")
set fx = fsox.OpenTextFile(outputFile, ForWriting, True)

' What is the name of the output file?
strDocName = InputBox("What would you like" & _ 
             " to name the output file?", TITLE)

' Create IP list to scan
Call IPCREATE()

'Get Script Location
pathlength = Len(WScript.ScriptFullName) - Len(WScript.ScriptName)
Scriptpath = Mid(WScript.ScriptFullName, 1, pathlength)

set adsi = CreateObject("ADSystemInfo") 
set wscr = CreateObject("WScript.Network") 

inputFile = "IP_table.txt" 
outputFile = "NA_IP.txt" 

set fso = CreateObject("Scripting.FileSystemObject") 
set f = fso.OpenTextFile(inputFile, ForReading, True) 
set fsox = CreateObject("Scripting.FileSystemObject") 
set fx = fsox.OpenTextFile(outputFile, ForWriting, True)
Set Cshell = CreateObject("WScript.Shell")
computerIndex = 1 

'*****[ FUNCTIONS ]******************************* 

Function Ask(strAction) 
   intButton = MsgBox(strAction, vbQuestion + vbYesNo, TITLE)
   Ask = intButton = vbNo
End Function 

Function IsConnectible(sHost, iPings, iTO)

Const OpenAsASCII = 0 
Const FailIfNotExist = 0 
Const ForReading = 1 
Dim oShell, oFSO, sTempFile, fFile

If iPings = "" Then iPings = 2 
If iTO = "" Then iTO = 750 

Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject") 

sTempFile = oFSO.GetSpecialFolder(2).ShortPath & "\" & oFSO.GetTempName

oShell.Run "%comspec% /c ping.exe -n " & iPings & " -w " & _
           iTO & " " & sHost & ">" & sTempFile, 0 , True 
Set fFile = oFSO.OpenTextFile(sTempFile, ForReading, _
                              FailIfNotExist, OpenAsASCII) 

Select Case InStr(fFile.ReadAll, "TTL=")
Case 0 IsConnectible = False 
Case Else IsConnectible = True 
End Select 

fFile.Close
oFSO.DeleteFile(sTempFile) 

End Function


'*****[ MAIN SCRIPT ]*****************************

If Ask("Run AssetScan now?") Then 
Wscript.Quit 
Else 
strStart = "Inventory run started: " & Date & " at " & time 
End If 

Call BuildXLS() 
Call Connect() 
Call Footer()

objXL.ActiveWorkbook.SaveAs Scriptpath & _
                     strDocName & "-AssetScan.xls"
MsgBox "Your inventory run is complete!", _
                     vbInformation + vbOKOnly, TITLE

'*****[ SUB ROUTINES ]****************************

'*** Subroutine create ip table
Sub IPCREATE()

   currentIP = getip()   

   dim Seps(2)
   Seps(0) = "."
   Seps(1) = "."
   test2 = Tokenize(currentIP, Seps)

   strSubIP = test2(0) & "." & test2(1) & "." & test2(2) & "."
   strSubIP = InputBox ("Enter Subnet to Scan - ie: 192.168.5." & _ 
              " Press <enter> to Scan Local Subnet", _
              Title, strSubIP)
    On Error Resume Next
        intStartingAddress = InputBox ("Start at :", _
                  "Scanning Subnet: "&strSubIP, 61)
        intEndingAddress = InputBox ("End at :", "Scanning Subnet: "_
                  & strSubIP&intStartingAddress, 254)

    For i = intStartingAddress to intEndingAddress
        strComputer = strSubIP & i
        fx.WriteLine(strSubIP & i)
    Next

End Sub

Function Tokenize(byVal TokenString, byRef TokenSeparators())

   Dim NumWords, a()
   NumWords = 0
   
   Dim NumSeps
   NumSeps = UBound(TokenSeparators)
   
   Do 
      Dim SepIndex, SepPosition
      SepPosition = 0
      SepIndex    = -1
      
      for i = 0 to NumSeps-1
      
         ' Find location of separator in the string
         Dim pos
         pos = InStr(TokenString, TokenSeparators(i))
         
         ' Is the separator present, and is it closest
         ' to the beginning of the string?
         If pos > 0 and ( (SepPosition = 0) or _
                          (pos < SepPosition) ) Then
            SepPosition = pos
            SepIndex    = i
         End If
         
      Next

      ' Did we find any separators?   
      If SepIndex < 0 Then

         ' None found - so the token is the remaining string
         redim preserve a(NumWords+1)
         a(NumWords) = TokenString
         
      Else

         ' Found a token - pull out the substring      
         Dim substr
         substr = Trim(Left(TokenString, SepPosition-1))
   
         ' Add the token to the list
         redim preserve a(NumWords+1)
         a(NumWords) = substr
      
         ' Cutoff the token we just found
         Dim TrimPosition
         TrimPosition = SepPosition+Len(TokenSeparators(SepIndex))
         TokenString = Trim(Mid(TokenString, TrimPosition))
                  
      End If   
      
      NumWords = NumWords + 1
   loop while (SepIndex >= 0)
   
   Tokenize = a
   
End Function


Function GetIP()
  Dim ws : Set ws = CreateObject("WScript.Shell")
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim TmpFile : TmpFile = fso.GetSpecialFolder(2) & "/ip.txt"
  Dim ThisLine, IP
  If ws.Environment("SYSTEM")("OS") = "" Then
    ws.run "winipcfg /batch " & TmpFile, 0, True
  Else
    ws.run "%comspec% /c ipconfig > " & TmpFile, 0, True
  End If
  With fso.GetFile(TmpFile).OpenAsTextStream
    Do While NOT .AtEndOfStream
      ThisLine = .ReadLine
      If InStr(ThisLine, "Address") <> 0 Then
          IP = Mid(ThisLine, InStr(ThisLine, ":") + 2)
    Loop
    .Close
  End With
  'WinXP (NT? 2K?) leaves a carriage return at the end of line
  If IP <> "" Then
    If Asc(Right(IP, 1)) = 13 Then IP = Left(IP, Len(IP) - 1)
  End If
  GetIP = IP
  fso.GetFile(TmpFile).Delete  
  Set fso = Nothing
  Set ws = Nothing
End Function

function TranslateDomainRole(byVal roleID)
   Dim a

   Select Case roleID
      Case 0
         a = "Standalone Workstation"
      Case 1
         a = "Member Workstation"
      Case 2
         a = "Standalone Server"
      Case 3
         a = "Member Server"
      Case 4
         a = "Backup Domain Controller"
      Case 5
         a = "Primary Domain Controller"
   End Select
   TranslateDomainRole = a
end function

'*********************************************************
Sub Connect()
    Do While f.AtEndOfLine <> True
        strPC = f.ReadLine
        If strPC <> "" Then
            If Not IsConnectible(strpc, "", "") Then
                strNoPing = "Couldn't ping " & strPC
                'Call MsgNoPing()
                Call Error()
            Else
                On Error Resume Next
                set oWMI = GetObject("winmgmts:{impersonation" & _ 
                    "Level=impersonate}!//" & strPC & "/root/cimv2")

                If Err.Number <> 0 Then

                strNoConnect = "Couldn't connect to " & strPC
                'Call MsgNoConnect()
                Call Error()

               Else
                 
                  'Get IP Address
                  strCompName = UCase(strPC)
               
                  'Get Hostname
                  set HostName = oWMI.ExecQuery("select DNSHostName" & _ 
                      " from Win32_NetworkAdapterConfiguration" & _ 
                      " where IPEnabled=TRUE")
                  for each Host in HostName
                     strHostName = Host.DNSHostName
                  Next

                  'Get Domain and Role
                  Set colItems = _
                    oWMI.ExecQuery("SELECT * FROM Win32_ComputerSystem", _
                    "WQL",wbemFlagReturnImmediately + wbemFlagForwardOnly)

                  For Each objItem In colItems
                     strDomain = objItem.Domain
                     strRole = TranslateDomainRole(objItem.DomainRole)
                  Next

                  'Get Make, Model, Serial Number
                  Set colItems = oWMI.ExecQuery("SELECT * FROM" & _ 
                    " Win32_ComputerSystemProduct", "WQL", _
                    wbemFlagReturnImmediately + wbemFlagForwardOnly)

                  For Each objItem In colItems
                     strSerial = objItem.IdentifyingNumber
                     strModel = objItem.Name
                     strMake = objItem.Vendor
                  Next

                  'Get RAM (Total)
                  set MemorySet = oWMI.ExecQuery("select TotalPhysicalMemory, "_
                     & "TotalVirtualMemory, TotalPageFileSpace from "_
                     & "Win32_LogicalMemoryConfiguration")
                  for each Memory in MemorySet
                     strRAM = _
                      FormatNumber(Memory.TotalPhysicalMemory/1024,1)_
                      & " Mb"
                  Next

                  'Get Operating System and Service Pack Info
                  set OSSet = oWMI.ExecQuery("select Caption, " & _ 
                      "CSDVersion, SerialNumber " & _
                      "from Win32_OperatingSystem")
                  for each OS in OSSet
                     strOS = OS.Caption
                     strSP = OS.CSDVersion
                  Next

                  'Get BIOS Revision
                  Set colSettings = _
                      oWMI.ExecQuery ("Select * from Win32_BIOS")
                  For Each objBIOS in colSettings
                     strBIOSrev = objBIOS.Version
                  Next
                  
                  'Get Processor Type
                  set ProSet = oWMI.ExecQuery("select Name," & _ 
                      " MaxClockSpeed from Win32_Processor")
                  for each Pro in ProSet
                     strProc = Pro.Name
                     strSpeed = Pro.MaxClockSpeed & " MHZ"
                  Next

                  'Get Logged in user
                  set loggeduser = oWMI.ExecQuery("select UserName" & _ 
                      " from Win32_ComputerSystem")
                  for each logged in loggeduser
                     struser = logged.UserName
                  Next

                  'Get NIC Model 'ISOLATE PRIMARY NIC INFO
                  Set colSettings = oWMI.ExecQuery ("Select *" & _ 
                      " from Win32_NetworkAdapter")
                  i=1
                  For Each objComputer in colSettings
                     if ObjComputer.AdapterType = "Ethernet 802.3" Then
                        strNICmodel(i-1) = strMsg & _
                          "Interface["& i & "]: " & ObjComputer.Name
                        i=i+1
                     End if
                  NEXT

                  'Get Subnet Mask, MAC Address, Default Gateway
                  set IPConfigSet = oWMI.ExecQuery("select ServiceName," & _ 
                      " IPAddress, " & "IPSubnet, DefaultIPGateway," & _ 
                      " MACAddress from " & _
                      "Win32_NetworkAdapterConfiguration" & _ 
                      " where IPEnabled=TRUE")
                  Count = 0
                  for each IPConfig in IPConfigSet
                     Count = Count + 1
                  Next
                  ReDim sName(Count - 1)
                  ReDim sIP(Count - 1)
                  ReDim sMask(Count - 1)
                  ReDim sGate(Count - 1)
                  ReDim sMAC(Count - 1)
                  Count = 0
                  for each IPConfig in IPConfigSet
                     sName(Count) = IPConfig.ServiceName(0)
                     strNIC = sName(Count)
                     sIP(Count) = IPConfig.IPAddress(0)
                     strIP = sIP(Count)
                     sMask(Count) = IPConfig.IPSubnet(0)
                     strMask = sMask(Count)
                     sGate(Count) = IPConfig.DefaultIPGateway(0)
                     strGate = sGate(Count)
                     sMAC(Count) = IPConfig.MACAddress(0)
                     strMAC = sMAC(Count)
                     Count = Count + 1
                  Next

                  'Date Installed
                  Set colSettings = oWMI.ExecQuery ("Select *" & _ 
                      " from Win32_OperatingSystem")
                  For Each objComputer in colSettings
                     strDateInstalled = Objcomputer.InstallDate
                  NEXT

                  'EXTRA LOOP to call Add lines
                  set DiskSet = oWMI.ExecQuery("select DeviceID," & _ 
                      " FileSystem, Size, FreeSpace " & _
                      "from Win32_LogicalDisk where DriveType = '3'")

                  ReDim strDisk(RowNum,4)
                    for each Disk in DiskSet
                        Call AddLineToXLS(strCompName, strHostName, _
                             strDomain, strRole, strMake, strModel, _
                             strSerial, strRAM, strOS, strSP, _
                             strBIOSrev, strProc, strSpeed, struser, _
                             strMask, strGate, strMAC, _
                             strDateInstalled, strNICmodel)
                  Next
                  
               End If
            End If
        End If
    Loop
End Sub

'*** Subroutine to Build XLS ***
Sub BuildXLS() 

intRow = 1 
Set objXL = Wscript.CreateObject("Excel.Application") 
objXL.Visible = True 
objXL.WorkBooks.Add
objXL.Sheets("Sheet1").Select()
objXL.Sheets("Sheet1").Name = " AssetScan Inventory"

'** Set Row Height 
objXL.Rows(1).RowHeight = 25 

'** Set Column widths 
objXL.Columns(1).ColumnWidth = 9
objXL.Columns(2).ColumnWidth = 14
objXL.Columns(3).ColumnWidth = 7
objXL.Columns(4).ColumnWidth = 17
objXL.Columns(5).ColumnWidth = 16
objXL.Columns(6).ColumnWidth = 10
objXL.Columns(7).ColumnWidth = 15
objXL.Columns(8).ColumnWidth = 7
objXL.Columns(9).ColumnWidth = 26
objXL.Columns(10).ColumnWidth = 12
objXL.Columns(11).ColumnWidth = 14
objXL.Columns(12).ColumnWidth = 24
objXL.Columns(13).ColumnWidth = 15
objXL.Columns(14).ColumnWidth = 19
objXL.Columns(15).ColumnWidth = 11
objXL.Columns(16).ColumnWidth = 11
objXL.Columns(17).ColumnWidth = 14
objXL.Columns(18).ColumnWidth = 22
objXL.Columns(19).ColumnWidth = 37
objXL.Columns(20).ColumnWidth = 35
objXL.Columns(21).ColumnWidth = 35
objXL.Columns(22).ColumnWidth = 35
objXL.Columns(23).ColumnWidth = 35

'*** Set Cell Format for Column Titles ***
objXL.Range("A1:Z1").Select
objXL.Selection.Font.Bold = True
objXL.Selection.Font.Size = 8 
objXL.Selection.Interior.ColorIndex = 11 
objXL.Selection.Interior.Pattern = 1 'xlSolid 
objXL.Selection.Font.ColorIndex = 2 
objXL.Selection.WrapText = True 
objXL.Columns("A:Z").Select
objXL.Selection.HorizontalAlignment = 3 'xlCenter


'*** Set Column Titles ***
dim arrNicTitle(4)
arrNicTitle(0) = "NIC #1 Model"
arrNicTitle(1) = "NIC #2 Model"
arrNicTitle(2) = "NIC #3 Model"
arrNicTitle(3) = "NIC #4 Model"
arrNicTitle(4) = "NIC #5 Model"

' 15,16,17
Call AddLineToXLS("IP Address" , "Hostname" , _
     "Domain" , "Role" , "Make" , "Model" , "Serial Number" , _
     "RAM" , "Operating System" , "Service Pack" , _
     "BIOS Revision" , "Processor Type" , "Processor Speed", _
     "Logged in user" , "Subnet Mask" , "Default Gateway", _
     "MAC Address", "Date Installed", arrNicTitle)

End Sub 

'*** Subroutine Add Lines to XLS *** 
objXL.Columns("A:AA").Select
objXL.Selection.HorizontalAlignment = 3 'xlCenter
objXL.Selection.Font.Size = 8

Sub AddLineToXLS(strCompName, strHostName, strDomain, _
      strRole, strMake, strModel, strSerial, strRAM, _
      strOS, strSP, strBIOSrev, strProc, strSpeed, struser, _
      strMask, strGate, strMAC, strDateInstalled, byRef strNICmodel)
    objXL.Cells(intRow, 1).Value = strCompName
    objXL.Cells(intRow, 2).Value = strHostName
    objXL.Cells(intRow, 3).Value = strDomain
    objXL.Cells(intRow, 4).Value = strRole
    objXL.Cells(intRow, 5).Value = strMake
    objXL.Cells(intRow, 6).Value = strModel
    objXL.Cells(intRow, 7).Value = strSerial
    objXL.Cells(intRow, 8).Value = strRAM
    objXL.Cells(intRow, 9).Value = strOS
    objXL.Cells(intRow, 10).Value = strSP
    objXL.Cells(intRow, 11).Value = strBIOSrev
    objXL.Cells(intRow, 12).Value = strProc
    objXL.Cells(intRow, 13).Value = strSpeed
    objXL.Cells(intRow, 14).Value = struser
    objXL.Cells(intRow, 15).Value = strMask
    objXL.Cells(intRow, 16).Value = strGate
    objXL.Cells(intRow, 17).Value = strMAC
    objXL.Cells(intRow, 18).Value = strDateInstalled
    objXL.Cells(intRow, 19).Value = strNICmodel(0)
    objXL.Cells(intRow, 20).Value = strNICmodel(1)
    objXL.Cells(intRow, 21).Value = strNICmodel(2)
    objXL.Cells(intRow, 22).Value = strNICmodel(3)
    objXL.Cells(intRow, 23).Value = strNICmodel(4)
    intRow = intRow + 1 
    objXL.Cells(1, 1).Select 
End Sub 

'*** Subroutine Add Lines to XLS for Disk Info. ***
'objXL.Columns("A:AA").Select
'objXL.Selection.HorizontalAlignment = 3 'xlCenter
'objXL.Selection.Font.Size = 8

Sub AddLineToDisk(strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE)
    objXL.Cells(intRow, 11).Value = strDEV_ID 
    objXL.Cells(intRow, 12).Value = strFSYS 
    objXL.Cells(intRow, 13).Value = strDSIZE 
    objXL.Cells(intRow, 14).Value = strFSPACE 
    objXL.Cells(intRow, 15).Value = strUSPACE 
    intRow = intRow + 1 
    objXL.Cells(1, 1).Select 
End Sub 

'*** Sub to add footer when speadsheet is complete *** 
Sub Footer()
   strFooter1 = "Inventory AssetScan"
   strFooter2 = "Script was created by Sean Kelly" & _ 
                " and is free for personal/small business use"
   strComplete = "Inventory run completed at: " & Date & " at " & time

   intRow = intRow + 4

   '** Set Cell Format for Row
   objXL.Cells(intRow, 4).Select
   objXL.Selection.Font.ColorIndex = 1
   objXL.Selection.Font.Size = 8
   objXL.Selection.Font.Bold = False
   objXL.Selection.HorizontalAlignment = 2 'xlRight
   objXL.Cells(intRow, 4).Value = strFooter1

   intRow = intRow + 1

   '** Set Cell Format for Row
   objXL.Cells(intRow, 4).Select
   objXL.Selection.Font.ColorIndex = 1
   objXL.Selection.Font.Size = 8
   objXL.Selection.Font.Bold = False
   objXL.Selection.HorizontalAlignment = 2 'xlRight
   objXL.Cells(intRow, 4).Value = strFooter2

   intRow = intRow + 1

   '** Set Cell Format for Row
   objXL.Cells(intRow, 4).Select
   objXL.Selection.Font.ColorIndex = 1
   objXL.Selection.Font.Size = 8
   objXL.Selection.Font.Bold = False
   objXL.Selection.HorizontalAlignment = 2 'xlRight
   objXL.Cells(intRow, 4).Value = strStart

   intRow = intRow + 1

   '** Set Cell Format for Row
   objXL.Cells(intRow, 4).Select
   objXL.Selection.Font.ColorIndex = 1
   objXL.Selection.Font.Size = 8
   objXL.Selection.Font.Bold = False
   objXL.Selection.HorizontalAlignment = 2 'xlRight
   objXL.Cells(intRow, 4).Value = strComplete

   intRow = intRow + 1

End Sub

'*** ErrorHandler *** 
Sub Error() 

fx.WriteLine(strPC)

End Sub