Question

我下面的代码确定了Access的版本。它在大多数PC上运行迅速。我们还有四台终端服务器。在两台终端服务器上运行正常。另外两个，这段代码需要15秒才能运行。

所有四个终端服务器都具有Access 2003运行时。我无法弄清楚为什么在两台服务器上运行需要更长的时间。它是权限吗？或者安装Access运行时的方式有些错误？

如果有更好，更快的方式来确定版本，我也会对此感兴趣。谢谢 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

我认为问题是对 CreateObject（）的调用。这将运行Access，我猜在某些机器上可能需要15秒。这是获得版本号的另一种方法，它应该快得多 - 它使用了注册中的信息。

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 2

此示例非常快速地返回已安装的Access版本列表。如果只返回一个，则无需进一步检查。

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

Answer 3

这是一个非常漫长的过程，但如果您正在运行已编译的.NET应用程序，请确保您运行该应用程序的计算机可以访问Internet，因为.NET应用程序喜欢连接到Microsoft的网站以进行验证

Answer 4

这是如何获取已安装的Excel版本。

Imports Microsoft.Office.Interop.Excel
Public Class ExcelVersion
    Dim xl As Application
    Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handlers NextCmd.Click
       xl = New Application
       MsgBox xl.Version()
       xl.Quit()
    End Sub
End Class

查找Access版本

4 个答案: