0
votes

I'm trying to get the name of the Oracle driver to use in the DSN-less ODBC connection string, so that I don't have to create an ODBC connection on each computer that the databases are installed on.

I have the code below and it works for me (Windows 10 64 bit, Oracle driver 32 bit, 12.2.0.1). For another person, however, it doesn't work, it just doesn't find her driver (Windows 10 64 bit, Oracle driver 64 bit, 12.2.0.1).

Online it says that the 2 registry entries in the code are used for 64bit and 32 bit respectively (so her driver should've been found in the first part). My driver is found in both parts of the code, hers isn't found in either.

    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
1

1 Answers

1
votes

Maybe your excel.exe and her excel.exe are 32bit version excel.exe. In those case accessing to the registry is automatically redirected to Wow6432node by the Windows. To turn off the redirection , you can use the techinique from https://docs.microsoft.com/en-us/windows/win32/wmisdk/requesting-wmi-data-on-a-64-bit-platform.

Since I don't have Oracle installed , I couldn't try my code , but how about this.

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