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 the other two, this code takes over 15 seconds to run.

All four terminal servers have Access 2003 runtime. I can't figure out why it would take longer to run on two servers. Would it be permissions? Or some mistake in the way the Access runtime was installed?

If there is a better, quicker way of determining the Version, I'd be interested in that too. Thanks Awesomo

   ' Determine the Access version by creating an
   ' Access.Application object and looking at
   ' its Version property.
   Private Function GetAccessVersionName() As String
      Dim obj As Object = CreateObject("Access.Application")
      Dim result As String = "Access.Application." & _
          obj.Version
      obj.Quit()
      Return result
   End Function

   ' Get the Access version number from the name.
   Private Function GetAccessVersionNumber() As Integer
      Dim txt As String = GetAccessVersionName()
      Dim pos2 As Integer = txt.LastIndexOf(".")
      Dim pos1 As Integer = txt.LastIndexOf(".", pos2 - 1)
      txt = txt.Substring(pos1 + 1, pos2 - pos1 - 1)
      Return CInt(txt)
   End Function

   ' Get the nice style of the Access version name.
   Public Function GetAccessVersionNiceName() As String

      Try
         Select Case GetAccessVersionNumber()
            Case 8
               Return "Access 97"
            Case 9
               Return "Access 2000"
            Case 10
               Return "Access XP" 
            Case 11
               Return "Access 2003"
            Case 12
               Return "Access 2007"
            Case Else
               Return "unknown"
         End Select
      Catch ex As Exception
         Return "unknown"
      End Try

   End Function

Answer 1

This is a VERY long shot, but if you're running a compiled .NET app, make sure the machines you're running the app on have Internet access, because the .NET apps like to connect to Microsoft's website to validate.

Answer 2

I think the problem is the call to CreateObject(). This will run up Access which I guess can take 15 seconds on some machines. Here’s a alternative way to get the version number which should be a lot faster – it uses the information in the registery.

Imports Microsoft.Win32

Public Class AccessInterop
    Public Shared Function GetAccessVersionNiceName() As String
        Try
            Dim ClassName As String = GetAccessClassName()
            Select Case GetAccessVersionNumber(ClassName)
                Case 8
                    Return "Access 97"
                Case 9
                    Return "Access 2000"
                Case 10
                    Return "Access XP"
                Case 11
                    Return "Access 2003"
                Case 12
                    Return "Access 2007"
                Case 13
                    Return "Access 2010"
                Case Else
                    Return "unknown"
            End Select
        Catch ex As Exception
            Return "unknown"
        End Try
    End Function

    Private Shared Function GetAccessClassName() As String
        Dim RegKey As RegistryKey = Microsoft.Win32.Registry.ClassesRoot.OpenSubKey("Access.Application\CurVer")
        If RegKey Is Nothing Then
            Throw New ApplicationException("Can not find MS Access version number in registry")
        Else
            Return RegKey.GetValue("")
        End If
    End Function

    Public Shared Function GetAccessVersionNumber(ByVal ClassName As String) As Integer
        Dim VersionNumber As String = ClassName
        While VersionNumber.IndexOf(".") > -1
            VersionNumber = VersionNumber.Substring(VersionNumber.IndexOf(".") + 1)
        End While
        Return VersionNumber.Trim
    End Function
End Class

Answer 3

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