VBA 正在检测 Oracle 驱动程序版本 32 位与 64 位

Question

我正在尝试获取要在无 DSN ODBC 连接字符串中使用的 Oracle 驱动程序的名称，这样我就不必在安装数据库的每台计算机上都创建 ODBC 连接。

我有下面的代码，它适用于我（Windows 10 64 位，Oracle 驱动程序 32 位，12.2.0.1）。然而，对于另一个人来说，它不起作用，它只是找不到她的驱动程序（Windows 10 64 位，Oracle 驱动程序 64 位，12.2.0.1）。

网上说代码中的2个注册表项分别用于64位和32位（所以她的驱动程序应该已经在第一部分找到了）。我的驱动程序在代码的两个部分中都找到了，而她的驱动程序在两个部分中都找不到。

    Public Function GetOracleDriver()




     Dim strComputer As String
     Dim strValueName As String


    Dim arrValueNames As Variant
    Dim arrValueTypes As Variant
    Dim i As Long
    Dim R As Long
    Dim strKeyPath As String
    Dim strValue As String
    Dim objReg As Object
    Dim MyDriverName As String



    Const HKEY_LOCAL_MACHINE = &H80000002

    R = 1


    strComputer = "."

    Set objReg = GetObject("winmgmts:\" & strComputer & "\root\default:StdRegProv")

    strKeyPath = "SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers"
    objReg.EnumValues HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames, arrValueTypes

    For i = 0 To UBound(arrValueNames)
        strValueName = arrValueNames(i)
        objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
                   If strValue = "Installed" And (arrValueNames(i) Like "*oracle*" And arrValueNames(i) <> "Microsoft ODBC for oracle") Then
                  GetOracleDriver = arrValueNames(i)
                  End If

        R = R + 1
    Next i

If IsNull(GetOracleDriver) Then

    R = 1

    strComputer = "."

    Set objReg = GetObject("winmgmts:\" & strComputer & "\root\default:StdRegProv")

    strKeyPath = "SOFTWARE\WOW6432NODE\ODBC\ODBCINST.INI\ODBC Drivers"
    objReg.EnumValues HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames, arrValueTypes

    For i = 0 To UBound(arrValueNames)
        strValueName = arrValueNames(i)
        objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
                   If strValue = "Installed" And (arrValueNames(i) Like "*oracle*" And arrValueNames(i) <> "Microsoft ODBC for oracle") Then
                  GetOracleDriver = arrValueNames(i)
                  End If

        R = R + 1
    Next i


End If
'Debug.Print GetOracleDriver

End Function

Answer 1

也许你的 excel.exe 和她的 excel.exe 是 32 位版本 excel.exe。在那些情况下，对注册表的访问会被 Windows 自动重定向到 Wow6432node。要关闭重定向，您可以使用来自 https://docs.microsoft.com/en-us/windows/win32/wmisdk/requesting-wmi-data-on-a-64-bit-platform.

因为我没有安装 Oracle，所以我无法尝试我的代码，但是这个怎么样。

Public Function GetOracleDriver()

     Dim strComputer As String
     Dim strValueName As String

    Dim arrValueNames As Variant
    Dim arrValueTypes As Variant
    Dim i As Long
    Dim R As Long
    Dim strKeyPath As String
    Dim strValue As String
    Dim objReg As Object
    Dim MyDriverName As String



    Const HKEY_LOCAL_MACHINE = &H80000002

    R = 1


    strComputer = "."
        
    '64bit
    
    'The code derives from
    'https://docs.microsoft.com/en-us/windows/win32/wmisdk/requesting-wmi-data-on-a-64-bit-platform
    Const HKLM = &H80000002
    Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
    objCtx.Add "__ProviderArchitecture", 64
    objCtx.Add "__RequiredArchitecture", True
    Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
    Set objServices = objLocator.ConnectServer(strComputer, "root\default", "", "", , , , objCtx)
    Set objStdRegProv = objServices.Get("StdRegProv")

    'Set objReg = GetObject("winmgmts:\" & strComputer & "\root\default:StdRegProv")
    Set objReg = objStdRegProv
    
    strKeyPath = "SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers"
    objReg.EnumValues HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames, arrValueTypes

    For i = 0 To UBound(arrValueNames)
        strValueName = arrValueNames(i)
        objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
        Debug.Print strKeyPath, strValueName, strValue
                   If strValue = "Installed" And (arrValueNames(i) Like "*oracle*" And arrValueNames(i) <> "Microsoft ODBC for oracle") Then
                  GetOracleDriver = arrValueNames(i)
                  End If

        R = R + 1
    Next i
End
'32bit
If IsNull(GetOracleDriver) Then

    R = 1

    strComputer = "."

    Set objReg = GetObject("winmgmts:\" & strComputer & "\root\default:StdRegProv")

    strKeyPath = "SOFTWARE\WOW6432NODE\ODBC\ODBCINST.INI\ODBC Drivers"
    objReg.EnumValues HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames, arrValueTypes

    For i = 0 To UBound(arrValueNames)
        strValueName = arrValueNames(i)
        objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
                   If strValue = "Installed" And (arrValueNames(i) Like "*oracle*" And arrValueNames(i) <> "Microsoft ODBC for oracle") Then
                  GetOracleDriver = arrValueNames(i)
                  End If

        R = R + 1
    Next i


End If

End Function

VBA 正在检测 Oracle 驱动程序版本 32 位与 64 位

VBA Detecting Oracle Driver version 32bit vs 64 bit

oracle

ms-access

odbc

vba