Find Version of Access

Question

I have code below which determines the version of Access. It runs quickly on most PCs. We also have four terminal servers. On two of the terminal servers it runs fine. On th

Answer 1

This example returns a list of installed versions of Access quite quickly. There is no need to check further if only one is returned.

Const HKEY_LOCAL_MACHINE = &H80000002&

Set fs = CreateObject("Scripting.FileSystemObject")

strComputer = "."
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\default:StdRegProv")
strKeyPathOrg = "SOFTWARE\Microsoft\Office"
strKeyPath = strKeyPathOrg
strValueName = "Path"

strKeyPath = strKeyPathOrg
objReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys

For Each subkey In arrSubKeys

    Select Case subkey
      Case "14.0"
      strKeyPath = strKeyPathOrg & "\" & subkey & "\Access\InstallRoot\"
      objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
      If Not IsNull(strValue) Then
            If fs.FileExists(strValue & "msaccess.exe") Then
               r = r & "Has Access 2010" & vbCrLf
            End If
      End If

      Case "12.0"
      strKeyPath = strKeyPathOrg & "\" & subkey & "\Access\InstallRoot\"
      objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
      If Not IsNull(strValue) Then
            If fs.FileExists(strValue & "msaccess.exe") Then
               r = r & "Has Access 2007" & vbCrLf
            End If
      End If

      Case "11.0"
      strKeyPath = strKeyPathOrg & "\" & subkey & "\Access\InstallRoot\"
      objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
      If Not IsNull(strValue) Then
            If fs.FileExists(strValue & "msaccess.exe") Then
               r = r & "Has Access 2003" & vbCrLf
            End If
      End If

      Case "10.0"
      strKeyPath = strKeyPathOrg & "\" & subkey & "\Access\InstallRoot\"
      objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
      If Not IsNull(strValue) Then
            If fs.FileExists(strValue & "msaccess.exe") Then
               r = r & "Has Access XP" & vbCrLf
            End If
      End If

      Case "9.0"
      strKeyPath = strKeyPathOrg & "\" & subkey & "\Access\InstallRoot\"
      objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
      If Not IsNull(strValue) Then
            If fs.FileExists(strValue & "msaccess.exe") Then
               r = r & "Has Access 2000" & vbCrLf
            End If
      End If

      Case "8.0"
      strKeyPath = strKeyPathOrg & "\" & subkey & "\Access\InstallRoot\"
      objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
      If Not IsNull(strValue) Then
            If fs.FileExists(strValue & "msaccess.exe") Then
               r = r & "Has Access 97" & vbCrLf
            End If
      End If
    End Select

Next

MsgBox r