Visual Basic code to generate a list of ODBC drivers

Posted on 2006-05-04
Last Modified: 2013-11-25
I am looking for a way to read out a list of ODBC drivers that exist on my machine using Visual Basic.  Thanks.
Question by:Greenbase
    LVL 44

    Expert Comment

    Hi Greenbase,

    there is a tip posted here doing that
    hope this helps a bit


    Author Comment

    Will this work in Visual Basic for Applications in Access 2003?
    LVL 14

    Expert Comment

    Also take a look at this link:~

    LVL 44

    Accepted Solution

    turns out you needed a second tip for retrieving the registry values

    you can use this in a module [not sure if i can post that here] teh test will print the values to the debug window

    Option Explicit

    Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
        (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
        ByVal samDesired As Long, phkResult As Long) As Long
    Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As _
    Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" _
        (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
        lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
        lpData As Any, lpcbData As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
        Any, source As Any, ByVal numBytes As Long)

    Const HKEY_LOCAL_MACHINE = &H80000002
    Const REG_SZ = 1
    Const REG_EXPAND_SZ = 2
    Const REG_BINARY = 3
    Const REG_DWORD = 4
    Const REG_MULTI_SZ = 7
    Const ERROR_MORE_DATA = 234
                              ' KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not
                              ' SYNCHRONIZE))

    ' Enumerate values under a given registry key
    ' returns a collection, where each element of the collection
    ' is a 2-element array of Variants:
    '    element(0) is the value name, element(1) is the value's value

    Function EnumRegistryValues(ByVal hKey As Long, ByVal KeyName As String) As _
        Dim handle As Long
        Dim index As Long
        Dim valueType As Long
        Dim name As String
        Dim nameLen As Long
        Dim resLong As Long
        Dim resString As String
        Dim dataLen As Long
        Dim valueInfo(0 To 1) As Variant
        Dim retVal As Long
        ' initialize the result
        Set EnumRegistryValues = New Collection
        ' Open the key, exit if not found.
        If Len(KeyName) Then
            If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit Function
            ' in all cases, subsequent functions use hKey
            hKey = handle
        End If
            ' this is the max length for a key name
            nameLen = 260
            name = Space$(nameLen)
            ' prepare the receiving buffer for the value
            dataLen = 4096
            ReDim resBinary(0 To dataLen - 1) As Byte
            ' read the value's name and data
            ' exit the loop if not found
            retVal = RegEnumValue(hKey, index, name, nameLen, ByVal 0&, valueType, _
                resBinary(0), dataLen)
            ' enlarge the buffer if you need more space
            If retVal = ERROR_MORE_DATA Then
                ReDim resBinary(0 To dataLen - 1) As Byte
                retVal = RegEnumValue(hKey, index, name, nameLen, ByVal 0&, _
                    valueType, resBinary(0), dataLen)
            End If
            ' exit the loop if any other error (typically, no more values)
            If retVal Then Exit Do
            ' retrieve the value's name
            valueInfo(0) = Left$(name, nameLen)
            ' return a value corresponding to the value type
            Select Case valueType
                Case REG_DWORD
                    CopyMemory resLong, resBinary(0), 4
                    valueInfo(1) = resLong
                Case REG_SZ, REG_EXPAND_SZ
                    ' copy everything but the trailing null char
                    resString = Space$(dataLen - 1)
                    CopyMemory ByVal resString, resBinary(0), dataLen - 1
                    valueInfo(1) = resString
                Case REG_BINARY
                    ' shrink the buffer if necessary
                    If dataLen < UBound(resBinary) + 1 Then
                        ReDim Preserve resBinary(0 To dataLen - 1) As Byte
                    End If
                    valueInfo(1) = resBinary()
                Case REG_MULTI_SZ
                    ' copy everything but the 2 trailing null chars
                    resString = Space$(dataLen - 2)
                    CopyMemory ByVal resString, resBinary(0), dataLen - 2
                    valueInfo(1) = resString
                Case Else
                    ' Unsupported value type - do nothing
            End Select
            ' add the array to the result collection
            ' the element's key is the value's name
            EnumRegistryValues.Add valueInfo, valueInfo(0)
            index = index + 1
        ' Close the key, if it was actually opened
        If handle Then RegCloseKey handle
    End Function

    ' get the list of ODBC drivers through the registry
    ' returns a collection of strings, each one holding the
    ' name of a driver, e.g. "Microsoft Access Driver (*.mdb)"
    ' requires the EnumRegistryValues function

    Function GetODBCDrivers() As Collection
        Dim res As Collection
        Dim values As Variant
        ' initialize the result
        Set GetODBCDrivers = New Collection
        ' the names of all the ODBC drivers are kept as values
        ' under a registry key
        ' the EnumRegistryValue returns a collection
        For Each values In EnumRegistryValues(HKEY_LOCAL_MACHINE, _
            "Software\ODBC\ODBCINST.INI\ODBC Drivers")
            ' each element is a two-item array:
            ' values(0) is the name, values(1) is the data
            If StrComp(values(1), "Installed", 1) = 0 Then
                ' if installed, add to the result collection
                GetODBCDrivers.Add values(0), values(0)
            End If
    End Function

    Sub test()
    Dim rcol As Collection, i As Integer
    Set rcol = GetODBCDrivers
    For i = 1 To rcol.Count
      Debug.Print rcol(i)
    Next i
    End Sub

    Featured Post

    What Security Threats Are You Missing?

    Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

    Join & Write a Comment

    Introduction While answering a recent question ( in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
    The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
    Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
    This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA.…

    733 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    18 Experts available now in Live!

    Get 1:1 Help Now