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"