Option Explicit

Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
      Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal _
      lpValueName As String, ByVal lpReserved As Long, lpType _
      As Long, lpData As Any, lpcbData As Any) As Long

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 Long

Private Const ERROR_SUCCESS = &H0

Private Const HKEY_CLASSES_ROOT As Long = &H80000000

Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_READ = KEY_QUERY_VALUE Or _
                         KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY

Private Const REG_SZ = &H1

Public Function GetCompPath(ByVal strKlasse As String) As String
  Dim nRetVal    As Long
  Dim hKey       As Long
  Dim strBuffer  As String

  Dim strClassID As String

  nRetVal = RegOpenKeyEx(HKEY_CLASSES_ROOT, strKlasse & _
                              "\CLSID", 0, KEY_READ, hKey)

  If nRetVal = ERROR_SUCCESS Then
    strBuffer = Space$(512)
    nRetVal = RegQueryValueEx(hKey, vbNullString, _
          0, REG_SZ, ByVal strBuffer, Len(strBuffer))

    If nRetVal = ERROR_SUCCESS Then
      strClassID = Left$(strBuffer, _
                    InStr(1, strBuffer, Chr$(0)) - 1)

      nRetVal = RegOpenKeyEx(HKEY_CLASSES_ROOT, "CLSID\" & _
            strClassID & "\InprocServer32", 0, KEY_READ, hKey)

      If nRetVal = ERROR_SUCCESS Then
        strBuffer = Space$(512)
        nRetVal = RegQueryValueEx(hKey, vbNullString, _
              0, REG_SZ, ByVal strBuffer, Len(strBuffer))

        If nRetVal = ERROR_SUCCESS Then
          GetCompPath = Left$(strBuffer, _
                         InStr(1, strBuffer, Chr$(0)) - 1)
        End If
      End If
    End If
  End If

  RegCloseKey hKey
End Function

Dim strPath As String

strPath = GetCompPath("DAO.DBEngine.36")
If Len(strPath) = 0 Then
  strPath = "Diese DLL oder ActiveX-Komponente ist " & _
                "nicht vorhanden!"
End If
MsgBox strPath