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检测到32位和64位的Oracle驱动程序版本

1 个答案: