局域网硬件扫描

'Attribute VB_Name = "Module1"
'Attribute VB_Name = "Module1"
'Attribute VB_Name = "Module1"
'~~Script~~.
'*********************************************************************
'Date: 1/3/2011
'Title: SW_Inv.vbs
'Use: Create hardware inventory and dumps info to Excel Spreadsheet.
'Comment: Must have ADSI and WMI installed on PC running script.
' Must have Admin rights on machines you connect to.
'*********************************************************************

'*****[ DECLARATIONS ]************************************************
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const DEV_ID = 0
Const FSYS = 1
Const DSIZE = 2
Const FSPACE = 3
Const USPACE = 4
Const TITLE = "MBC Inventory List"
Const outputFile = "PC_Inv.txt"

Dim fso, f, fx, fsox, outExist, DnameObj, objContainer, colPCs, objEnv, objDomain, objXL, wmiPath
Dim computerIndex, wscr, adsi, intbutton, strStart, strHighlight, strCount
Dim inputFile, objKill, strAction, strComplete, objSheet, iCount
Dim strPC, intRow, strFilter, RowNum, strCompName, outFileNA
Dim strSN, strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE
Dim strRAM, strVir, strPage, strOS, strSP, strProdID, strStatic
Dim strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed
Dim strValue, strManuf, strModel, strNetClient, strSoft, strSoftNull
Dim Major, Minor, Ver, message, key, key2, wshshell, dname
Dim strCurrentdir

Set adsi = CreateObject("ADSystemInfo")
Set wscr = CreateObject("work")
Set wshshell = WScript.CreateObject("WScript.Shell")

'***** List creation from active directory or User created ? ***
If (MsgBox("Do you want to create a list from active directory ? " & "", vbYesNo + vbQuestion, "INFO Tech CN Software Scanning") = vbYes) Then

inputFile = "PC_Inv.txt"

Else

inputFile = "PCRerun.txt"

End If

outFileNA = "PC_Inv_NA.txt"
'*****[ DOMAIN ]************************************************
'*** Get current Domain ***
key = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\Currentversion\Winlogon\CachePrimaryDomain"
dname = wshshell.RegRead(key)
Set objEnv = wshshell.Environment("process")
dname = objEnv("USERDOMAIN")

Call SysTest


'*** Bind to the builtin administrators group to see if you can connect ***
GetObject ("WinNT://" & dname & "/administrators")
If Err.Number Then
message = "Cannot bind to " & dname
wshshell.Popup message, 0, "Connection or Authority Failure", vbCritical
WScript.Quit
End If

DnameObj = "WinNT://" & dname
wshshell.Popup "Please Stand By.....", 3, "Query Domain", 64
Set objContainer = GetObject(DnameObj)
objContainer.Filter = Array("computer")

Set fso = CreateObject("Scripting.FileSystemObject")
Set fsox = CreateObject("Scripting.FileSystemObject")

Call KillFile

Set f = fso.OpenTextFile(inputFile, ForReading, True)
Set fx = fsox.OpenTextFile(outFileNA, ForWriting, True)
computerIndex = 1

'*********************************************************************

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

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

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

If Ask("Would you like to start and run inventory on Workstations") Then
WScript.Quit
Else
strStart = "Inventory run started: " & Date & " at " & Time
End If

Call BuildXLS
Call Connect
Call Footer
Set objShell = CreateObject("WScript.Shell")
strCurrentdir = objShell.CurrentDirectory
objXL.ActiveWorkbook.SaveAs strCurrentdir & "\" & "SW_Inv.xls"
MsgBox "Your inventory run has completed!", vbInformation + vbOKOnly, TITLE


'*********************************************************************

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

'*** Subroutine Connect ***
Sub Connect()
Do While f.AtEndOfLine <> True
' MsgBox "Your inventory run has completed!", vbInformation + vbOKOnly, TITLE
strPC = f.ReadLine
Call Error
On Error Resume Next

strCompName = UCase(strPC)
Set BIOSSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select SerialNumber from Win32_BIOS")
For Each BIOS In BIOSSet
strSN = BIOS.SerialNumber
Next

Set MemorySet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select TotalPhysicalMemory, TotalVirtualMemory, TotalPageFileSpace from Win32_LogicalMemoryConfiguration")
For Each Memory In MemorySet
strRAM = FormatNumber(Memory.TotalPhysicalMemory / 1024, 1) & " Mbytes"
strVir = FormatNumber(Memory.TotalVirtualMemory / 1024, 1) & " Mbytes"
strPage = FormatNumber(Memory.TotalPageFileSpace / 1024, 1) & " Mbytes"
Next

Set OSSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select Caption, CSDVersion, SerialNumber from Win32_OperatingSystem")
For Each OS In OSSet
strOS = OS.Caption
strSP = OS.CSDVersion
strProdID = OS.SerialNumber
Next


Set IPConfigSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select ServiceName, IPAddress, IPSubnet, DefaultIPGateway, MAC

Address 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

Set ProSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select Name, MaxClockSpeed from Win32_Processor")
For Each Pro In ProSet
strProc =
strSpeed = Pro.MaxClockSpeed
Next

Set UserSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select Manufacturer,Model,UserName from Win32_ComputerSystem")
For Each User In UserSet
strManuf = User.Manufacturer
strModel = User.Model
Next

Const HKEY_LOCAL_MACHINE = &H80000002
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strPC & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\WinLogon"
strValueName = "AltDefaultUserName"
oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue

Set NetworkClientSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select Caption from Win32_NetworkClient")
For Each NetworkClient In NetworkClientSet
strNetClient = NetworkClient.Caption
Next


'Call Disk_C()

'Call Disk_D()
'Call Disk_E()
'Call Disk_F()


'=======================================
' set SoftwareSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select Caption,Description,IdentifyingNumber,InstallDate,Name,Version from Win32_Product")
' for each Software in SoftwareSet
' strSoft =
' Call AddLineToSoftware(strSoft)
' Next
'=======================================

'========================================
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys

' For Each subkey In arrSubKeys
' UnistallValue = ""
' DisplayValue = ""
' strKeyPath1 = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & subkey
' oReg.EnumValues HKEY_LOCAL_MACHINE, strKeyPath1, arrValueNames, arrValueTypes
' oReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath1, "DisplayName", strValue
' DisplayValue = strValue
' If arrValueNames(i) = "UninstallString" Then
' oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath1,arrValueNames(i),strValue
' UnistallValue = strValue
' End if

' If UnistallValue <> "" And DisplayValue <> "" Then
' objTextFile.WriteLine "Software: " & DisplayValue ' & vbtab & UnistallValue
' End If


' Const ForReading = 1
' Const ForWriting = 2
' Set objFSO = CreateObject("Scripting.FileSystemObject")
' Set objFile = objFSO.OpenTextFile("Non_SW_List.txt", ForReading)
' strContents = objFile.ReadAll
' objFile.Close
'unSW = InStr(strValue, strContents)
' unSW = InStr(strContents, strValue)
' Wscript.Echo "strValue:" & strValue & " unSW:" & unSW
' Wsc

ript.Echo "strContents:" & strContents
'Wscript.Echo "unSW:" & unSW
' If strValue <> "" And unSW = 0 Then
'If strValue <> "" Then
' strSoft = strValue
'Call AddLineToSoftware(strSoft)

' Call AddLineToXLS(strCompName, strSoftNull, strSN, strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE, strRAM, strVir, strPage, strOS, strSP, strProdID, strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed, strValue, strManuf, strModel, strNetClient)
'Call AddLineToXLS(strCompName, strSoft, strSN, strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE, strRAM, strVir, strPage, strOS, strSP, strProdID, strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed, strValue, strManuf, strModel, strNetClient)

' End If
' Next
'========================================
Call AddLineToXLS(strCompName, strSoftNull, strSN, strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE, strRAM, strVir, strPage, strOS, strSP, strProdID, strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed, strValue, strManuf, strModel, strNetClient)

Loop

End Sub



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

intRow = 1
Set objXL = WScript.CreateObject("Excel.Application")
objXL.Visible = True
objXL.WorkBooks.Add

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

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


'*** Set Cell Format for Column Titles ***
objXL.Range("A1:Y1").Select
objXL.Selection.Font.Bold = True
objXL.Selection.Interior.ColorIndex = 11
objXL.

Selection.Interior.Pattern = 1 'xlSolid
objXL.Selection.Font.ColorIndex = 2
objXL.Selection.WrapText = True
objXL.Columns("A:Y").Select
objXL.Selection.HorizontalAlignment = 3 'xlCenter

'*** Set Column Titles ***
Call AddLineToXLS("Computer Name", "Software", "Serial Number", "Device ID", "File System", "Disk Size", "Free Space", "Used Space", "Physical Memory", "Virtual Memory", "Page File", "Operating System", "Service Pack", "Product ID", "Network Card", "IP Address", "Subnet Mask", "Default Gateway", "MAC Address", "Processor", "Speed", "Last User Logged On", "Manufacturer", "Model", "Network Client")

End Sub

'*** Subroutine Add Lines to XLS ***

Sub AddLineToXLS(strCompName, strSoftNull, strSN, strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE, strRAM, strVir, strPage, strOS, strSP, strProdID, strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed, strValue, strManuf, strModel, strNetClient)


objXL.Cells(intRow, 1).Value = strCompName
objXL.Cells(intRow, 2).Value = strSoftNull
objXL.Cells(intRow, 3).Value = strSN
objXL.Cells(intRow, 4).Value = strDEV_ID
objXL.Cells(intRow, 5).Value = strFSYS
objXL.Cells(intRow, 6).Value = strDSIZE
objXL.Cells(intRow, 7).Value = strFSPACE
objXL.Cells(intRow, 8).Value = strUSPACE
objXL.Cells(intRow, 9).Value = strRAM
objXL.Cells(intRow, 10).Value = strVir
objXL.Cells(intRow, 11).Value = strPage
objXL.Cells(intRow, 12).Value = strOS
objXL.Cells(intRow, 13).Value = strSP
objXL.Cells(intRow, 14).Value = strProdID
objXL.Cells(intRow, 15).Value = strNIC
objXL.Cells(intRow, 16).Value = strIP
objXL.Cells(intRow, 17).Value = strMask
objXL.Cells(intRow, 18).Value = strGate
objXL.Cells(intRow, 19).Value = strMAC
objXL.Cells(intRow, 20).Value = strProc
objXL.Cells(intRow, 21).Value = strSpeed
objXL.Cells(intRow, 22).Value = strValue
objXL.Cells(intRow, 23).Value = strManuf
objXL.Cells(intRow, 24).Value = strModel
objXL.Cells(intRow, 25).Value = strNetClient
'objXL.Cells(intRow, 25).Value = strSoftNull
intRow = intRow + 1
'objXL.Cells(1, 1).Select
End Sub

'*** Subroutine Add Lines to XLS for Disk Info. ***

Sub AddLineToDisk(strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE)

objXL.Cells(intRow, 4).Value = strDEV_ID
objXL.Cells(intRow, 5).Value = strFSYS
objXL.Cells(intRow, 6).Value = strDSIZE
objXL.Cells(intRow, 7).Value = strFSPACE
objXL.Cells(intRow, 8).Value = strUSPACE
intRow = intRow + 1
'objXL.Cells(1, 1).Select
End Sub

'*** Subroutine Add Lines to XLS ***

Sub AddLineToSoftware(strSoft)
If strPC = "" Then
objXL.Cells(intRow, 2).Value = ""
Else
objXL.Cells(intRow, 1).Value = strCompN

ame
objXL.Cells(intRow, 2).Value = strSoft
intRow = intRow + 1
'objXL.Cells(1, 1).Select
End If
End Sub



'*** Subroutine to parse C: Partition ***

Sub Disk_C()
Set DiskSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select DeviceID, FileSystem, Size, FreeSpace from Win32_LogicalDisk where DeviceID = 'C:' and DriveType = '3'")

ReDim strDisk(RowNum, 4)
For Each Disk In DiskSet
strDisk(RowNum, DEV_ID) = Disk.DeviceID
strDisk(RowNum, FSYS) = Disk.FileSystem
strDisk(RowNum, DSIZE) = FormatNumber(Disk.Size / 2 ^ 30, 1) & " Gbytes"
strDisk(RowNum, FSPACE) = FormatNumber(Disk.FreeSpace / 2 ^ 30, 1) & " Gbytes"
strDisk(RowNum, USPACE) = FormatNumber((Disk.Size - Disk.FreeSpace) / 2 ^ 30, 1) & " Gbytes"

Call AddLineToXLS(strCompName, strSN, strDisk(RowNum, DEV_ID), strDisk(RowNum, FSYS), strDisk(RowNum, DSIZE), strDisk(RowNum, FSPACE), strDisk(RowNum, USPACE), strRAM, strVir, strPage, strOS, strSP, strProdID, strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed, strValue, strManuf, strModel, strNetClient, strSoftNull)
Next
End Sub

'*** Subroutine to parse D: Partition ***

Sub Disk_D()
Set DiskSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select DeviceID, FileSystem, Size, FreeSpace from Win32_LogicalDisk where DeviceID = 'D:' and DriveType = '3'")
On Error Resume Next
ReDim strDisk(RowNum, 4)
For Each Disk In DiskSet
strDisk(RowNum, DEV_ID) = Disk.DeviceID
strDisk(RowNum, FSYS) = Disk.FileSystem
strDisk(RowNum, DSIZE) = FormatNumber(Disk.Size / 2 ^ 30, 1) & " Gbytes"
strDisk(RowNum, FSPACE) = FormatNumber(Disk.FreeSpace / 2 ^ 30, 1) & " Gbytes"
strDisk(RowNum, USPACE) = FormatNumber((Disk.Size - Disk.FreeSpace) / 2 ^ 30, 1) & " Gbytes"
If IsNull(strDisk(RowNum, FSYS)) Then
Exit Sub
End If

Call AddLineToDisk(strDisk(RowNum, DEV_ID), strDisk(RowNum, FSYS), strDisk(RowNum, DSIZE), strDisk(RowNum, FSPACE), strDisk(RowNum, USPACE))
Next
End Sub

Sub Disk_E()
Set DiskSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select DeviceID, FileSystem, Size, FreeSpace from Win32_LogicalDisk where DeviceID = 'E:' and DriveType = '3'")
On Error Resume Next
ReDim strDisk(RowNum, 4)
For Each Disk In DiskSet
strDisk(RowNum, DEV_ID) = Disk.DeviceID
strDisk(RowNum, FSYS) = Disk.FileSystem
strDisk(RowNum, DSIZE) = FormatNumber(Disk.Size / 2 ^ 30, 1) & " Gbytes"
strDisk(RowNum, FSPACE) = FormatNumber(Disk.FreeSpace / 2 ^

30, 1) & " Gbytes"
strDisk(RowNum, USPACE) = FormatNumber((Disk.Size - Disk.FreeSpace) / 2 ^ 30, 1) & " Gbytes"
If IsNull(strDisk(RowNum, FSYS)) Then
Exit Sub
End If
Call AddLineToDisk(strDisk(RowNum, DEV_ID), strDisk(RowNum, FSYS), strDisk(RowNum, DSIZE), strDisk(RowNum, FSPACE), strDisk(RowNum, USPACE))
Next
End Sub

Sub Disk_F()
Set DiskSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select DeviceID, FileSystem, Size, FreeSpace from Win32_LogicalDisk where DeviceID = 'F:' and DriveType = '3'")
On Error Resume Next
ReDim strDisk(RowNum, 4)
For Each Disk In DiskSet
strDisk(RowNum, DEV_ID) = Disk.DeviceID
strDisk(RowNum, FSYS) = Disk.FileSystem
strDisk(RowNum, DSIZE) = FormatNumber(Disk.Size / 2 ^ 30, 1) & " Gbytes"
strDisk(RowNum, FSPACE) = FormatNumber(Disk.FreeSpace / 2 ^ 30, 1) & " Gbytes"
strDisk(RowNum, USPACE) = FormatNumber((Disk.Size - Disk.FreeSpace) / 2 ^ 30, 1) & " Gbytes"
If IsNull(strDisk(RowNum, FSYS)) Then
Exit Sub
End If
Call AddLineToDisk(strDisk(RowNum, DEV_ID), strDisk(RowNum, FSYS), strDisk(RowNum, DSIZE), strDisk(RowNum, FSPACE), strDisk(RowNum, USPACE))
Next
End Sub

'*** Delete file if exists ***

Sub KillFile()

iCount = 0
Set objKill = CreateObject("Scripting.FileSystemObject")
If (objKill.FileExists("SW_Inv.xls")) Then
objKill.DeleteFile ("SW_Inv.xls")
End If
If (objKill.FileExists("PC_Inv.txt")) Then
' objKill.DeleteFile("PC_Inv.txt")
Else
WScript.echo "The PC list file PC_Inv.txt can not be found, please create it!"
End If
Set objKill = Nothing
'Set outExist = fso.OpenTextFile(outputFile, ForAppending, True)
'Set outExist = fso.OpenTextFile(outputFile, 1)
'For Each colPCs in objContainer
' outExist.writeline
' iCount = iCount + 1
'Next

Dim arrFileLines()
iCount = 0
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("PC_Inv.txt", 1)
Do Until objFile.AtEndOfStream
ReDim Preserve arrFileLines(iCount)
arrFileLines(iCount) = objFile.ReadLine
iCount = iCount + 1
Loop
objFile.Close

End Sub

'*** Sub to add footer when speadsheet is complete ***

Sub Footer() '最后面的签

名

strFooter1 = "INFO Tech CN"
strFooter2 = "ZEE Software Scanning Result"
strComplete = "Inventory run completed at: " & Date & " at " & Time
strHighlight = "Highlighted Computer Names indicate: No Rights, No Longer on Network, Powered Off"
strCount = "There are a Total of " & iCount & " Computer's Listed"

intRow = intRow + 5

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

intRow = intRow + 1

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

intRow = intRow + 1

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

intRow = intRow + 1

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

intRow = intRow + 1

'** Set Cell Format for Row
objXL.Cells(intRow, 1).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = True
objXL.Selection.HorizontalAlignment = 2 'xlLeft
objXL.Cells(intRow, 1).Value = strHighlight

intRow = intRow + 1

'** Set Cell Format for Row
objXL.Cells(intRow, 1).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = True
objXL.Selection.HorizontalAlignment = 2 'xlLeft
objXL.Cells(intRow, 1).Value = strCount

intRow = intRow + 1

Set objSheet = objXL.ActiveWorkbook.Worksheets(1)
objSheet.Select
objSheet.Range("B2").Select
objXL.ActiveWindow.FreezePanes = True


End Sub

'*

** ErrorHandler ***

Sub Error()

On Error Resume Next
Set CompSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select Name from Win32_ComputerSystem")
If Err Then
objXL.Cells(intRow, 1).Select
objXL.Selection.Interior.ColorIndex = 6
objXL.Selection.Font.ColorIndex = 3
objXL.Selection.Interior.Pattern = 1 'xlSolid
objXL.Selection.Font.Size = 12
objXL.Selection.Font.Bold = True
objXL.Selection.WrapText = True
objXL.Selection.HorizontalAlignment = 3 'xlLeft
objXL.Cells(intRow, 1).Value = strPC
objXL.Cells(intRow, 2).Select
objXL.Selection.Interior.ColorIndex = 6
objXL.Selection.Font.ColorIndex = 3
objXL.Selection.Interior.Pattern = 1 'xlSolid
objXL.Selection.Font.Size = 12
objXL.Selection.Font.Bold = True
objXL.Selection.WrapText = True
objXL.Selection.HorizontalAlignment = 3 'xlLeft
objXL.Cells(intRow, 2).Value = "---------"
intRow = intRow + 1
fx.WriteLine (strPC)
Set strPC = Nothing
End If
computerIndex = computerIndex + 1
End Sub

'*** Check Wscript ver and if ADSI is installed ***

Sub SysTest()
' WSH version tested
Major = (ScriptEngineMinorVersion())
Minor = (ScriptEngineMinorVersion()) / 10
Ver = Major + Minor
'Need version 5.5
If Err.Number Or Ver < 5.5 Then
message = "You have WScript Version " & Ver & ". Please load Version 5.5"
End If

'Test for ADSI
Err.Clear
key = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Active Setup\Installed Components\{E92B03AB-B707-11d2-9CBD-0000F87A369E}\version"
key2 = wshshell.RegRead(key)
If Err <> 0 Then
message = message & "ADSI must be installed on local workstation to continue" & vbCrLf
wshshell.Popup message, 0, "Workstation Setup Error", vbInformation
WScript.Quit
End If
End Sub

' Rename File Section
'fso.CopyFile "PCRerun.txt", "PCRerun" & Replace(FormatDateTime(Date(),2),"/","") & Replace(FormatDateTime(Time(),4),":","") & ".txt"
'fso.CopyFile "PC_Inv_NA.txt", "PCRerun.txt"
'fso.CopyFile "SW_Inv.xls", "SW_Inv" & Replace(FormatDateTime(Date(),2),"/","") & Replace(FormatDateTime(Time(),4),":","") & ".xls"
fso.CopyFile "PCRerun.txt", strCurrentdir & "\log\" & "PCRerun" & Replace(FormatDateTime(Date, 2), "/", "") & Replace(FormatDateTime(Time(), 4), ":", "") & ".txt"
fso.CopyFile "PC_Inv_NA.txt", strCurrentdir & "\log\" & "PC_Inv_NA" & Replace(FormatDateTime(Date, 2), "/", "") & Re

place(FormatDateTime(Time(), 4), ":", "") & ".txt"
'fso.CopyFile "PC_Inv_NA.txt", strCurrentdir & "\log\" & "PCRerun.txt"
fso.CopyFile "SW_Inv.xls", strCurrentdir & "\log\" & "SW_Inv" & Replace(FormatDateTime(Date, 2), "/", "") & Replace(FormatDateTime(Time(), 4), ":", "") & ".xls"