BaseIP = "192.168.100." 'Set this to match your IP subnet. Don't delete the period at the end.
StartIP = "1" 'Set this to the first IP in the range to scan
EndIP = "254" 'Set this to the last IP in the range to scan
Dim OfficeLog: OfficeLog = "OfficeVersionLog.txt" 'Used to build office log. Will be created in path where script is run.
Const ForAppending = 8
Const HKEY_LOCAL_MACHINE = &H80000002 'Used for connecting to remote registry to find Outlook install path
Set objFSO = CreateObject("Scripting.FileSystemObject")
'=================================
'Setup log file
'=================================
'Checks for log file. If it doens't exist, it creates it.
'Created in whatever directory the script is run from.
If NOT objFSO.FileExists (OfficeLog) Then
Set checkLog = objFSO.CreateTextFile(OfficeLog)
checkLog.Close
End If
'Opens log for use
Set objLog = objFSO.OpenTextFile(OfficeLog, ForAppending)
'================================
'Build IP range. Currently only sweeps class C subnets.
'================================
'For loop to create IP address range
For i = StartIP To EndIP
IP = BaseIP & i
'================================
'Ping PC before checking for Office
'================================
'Checks the PC to see if it is accessible. Writes result to log.
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}")._
ExecQuery("select * from Win32_PingStatus where address = '"& IP & "'")
For Each objStatus in objPing
If IsNull(objStatus.StatusCode) Or objStatus.StatusCode<>0 Then
objLog.WriteLine (Date & vbTab & Time & vbTab & IP & vbTab & "No response")
WScript.Echo Date & vbTab & Time & vbTab & IP & vbTab & "No response"
ElseIf objStatus.StatusCode=0 Then
'****************
'This section captures the PC name and writes it to the log
' in addition to the IP address for more useful logging.
'****************
On Error Resume Next
Set objWMIService = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & IP & "\root\cimv2")
If Err = 0 Then
Set colQry = objWMIService.ExecQuery("SELECT Name FROM Win32_ComputerSystem")
For Each Name In colQry
PCName = Name.name
'****************
'End PC name capture
'****************
'objLog.WriteLine (Date & vbTab & Time & vbTab & IP & vbTab & PCName & vbTab & "PC responded to connection")
'WScript.Echo Date & vbTab & Time & vbTab & IP & vbTab & PCName & vbTab & "PC responded to connection"
'================================
'Check Registry to find install path of office
'================================
'Access remote registry and read a string (REG_SZ) value.
'Use to check registry for the install path of Outlook.exe
Dim strKeyPath 'everything after the main key IE: KHEY_LOCAL_MACHINE
Dim strValueName 'The name of the actual value within a key that you want to read
Dim strOutlookPath 'Output of path from registry
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & IP & "\root\default:StdRegProv")
'strKeyPath is everything after the main key IE: KHEY_LOCAL_MACHINE
strKeyPath = "Software\Microsoft\Windows\Currentversion\App Paths\OUTLOOK.EXE"
'strValueName is the name of the actual value within a key that you want to read
strValueName = "Path"
objReg.getStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strOutlookPath
'================================
'Get Office version
'================================
IF strOutlookPath <> "" THEN
getFile=strOutlookPath & "WINWORD.EXE"
getFile=Replace(getFile,":","$")
getFile = "\\" & IP & "\" & getFile
OfficeVersion = objFSO.GetFileVersion(getFile)
Select Case left(OfficeVersion,2)
Case "9."
OfficeExternalVersion = "(Office 2000)"
Case "10"
OfficeExternalVersion = "(Office XP)"
Case "11"
OfficeExternalVersion = "(Office 2003)"
Case "12"
OfficeExternalVersion = "(Office 2007)"
Case "14"
OfficeExternalVersion = "(Office 2010)"
Case "15"
OfficeExternalVersion = "(Office 2013)"
Case "16"
OfficeExternalVersion = "(Office 2016)"
End Select
objLog.WriteLine (Date & vbTab & Time & vbTab & IP & vbTab & PCName & vbTab & "Office version is: " & vbTab & OfficeVersion & vbTab & OfficeExternalVersion)
WScript.Echo Date & vbTab & Time & vbTab & IP & vbTab & PCName & vbTab & "Office version is: " & vbTab & OfficeVersion & vbTab & OfficeExternalVersion
ELSE
objLog.WriteLine (Date & vbTab & Time & vbTab & IP & vbTab & PCName & vbTab & "Office not installed")
WScript.Echo Date & vbTab & Time & vbTab & IP & vbTab & PCName & vbTab & "Office not installed"
END IF
NEXT
ELSE
objLog.WriteLine (Date & vbTab & Time & vbTab & IP & vbTab & "No Windows-Domain PC")
WScript.Echo Date & vbTab & Time & vbTab & IP & vbTab & "No Windows-Domain PC"
END IF
END IF
NEXT
NEXT
WScript.Echo "Script Complete"