How to check the office version remotely?

Solution 1:

I've created a vbscript based on an earlier out-of-date version of DSCunningham to manage that job.

Enjoy!

'==========================================================================
'
' VBScript Source File 2.0
'
' NAME: PingSweep-OfficeVersion2.vbs
'
' AUTHOR OF THE FIRST VERSION: DSCunningham 08/03/2011
' AUTHOR OF THE SECOND VERSION: Laurent Mander 07/05/2016
'
' COMMENT: 
'   Sets up log file
'   Builds IP range & sweeps range using for next Loop
'   Gets computer name from IP for better logging
'   Gets office (WINWORD.exe) install path from registry
'   Gets office (WINWORD.exe) version number and logs result
' I'm using WINWORD.exe as the basis for determining the office version
' You could easily change it to check for msexcel.exe by changing the registry path and file name.
'
' COMMENT SECOND VERSION:
'   Script works with actual windows and office versions
'   Script doesn't brake up on NON-Windows PCs
'   Script doesn't brake up on "Office not found"
'   Script shows exact internal+external Office verison
'
'   >You have to run the script with network administrator rights
'
'==========================================================================
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"