Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal _
  hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal _
  lpszAttributes As String) As Long
 
Private Const ODBC_ADD_SYS_DSN = 4
 
Private Const SQL_FETCH_NEXT = 1
 
Private Declare Function SQLGetInstalledDrivers Lib "ODBCCP32.DLL" _
   (ByVal s As String, ByVal sl As Integer, ByRef so As Integer) As Long
 
Private Declare Function SQLFreeEnv Lib "ODBC32.DLL" (ByVal han As Long) _
   As Long
 
Private Declare Function SQLAllocEnv Lib "ODBC32.DLL" (ByRef han As Long) _
   As Long
 
Private Declare Function SQLDataSources Lib "ODBC32.DLL" (ByVal han As _
   Long, ByVal iDir As Integer, ByVal sServerName As String, ByVal _
   iBuf1 As Integer, ByRef iRealBuf1 As Integer, ByVal sDesc As String, _
   ByVal iBuf2 As Integer, ByRef iRealBuf2 As Integer) As Long
 
Public Function addDSN(DriverName As String, DSNName As String, Server As _
  String, Description As String)
    Dim Added As Long
 
    Added = SQLConfigDataSource(0, ODBC_ADD_SYS_DSN, DriverName + vbNullChar, _
      "DSN=" + DSNName + vbNullChar + "UID=" + vbNullChar + "pwd=" + vbNullChar _
      + "Server=" + Server + vbNullChar + "Description=" + Description + _
      vbNullChar)
 
    If Added = 0 Then
        MsgBox "DSN konnte nicht hinzugefügt werden !", vbOKOnly, "ODBC Error"
    Else
        MsgBox "DSN wurde erfolgreich hinzugefügt !", vbOKOnly, "ODBC"
    End If
End Function
 
Public Function EnumDSNs(DSNList As Collection)
 
    Dim sDSN As String
    Dim sDSNString As String
    Dim sDesc As String
 
    Dim iLenDSN As Integer
    Dim iLenDesc As Integer
    Dim nRet As Long
    Dim hSQL As Long
 
    Dim bContinue As Boolean
 
    bContinue = False
 
    SQLAllocEnv hSQL
 
    Do
        sDSN = Space(1024)
        sDesc = Space(1024)
 
        If bContinue Then
            nRet = SQLDataSources(hSQL, SQL_FETCH_NEXT, sDSN, _
                   1024, iLenDSN, sDesc, 1024, iLenDesc)
        Else
            nRet = SQLDataSources(hSQL, 32, sDSN, 1024, _
                   iLenDSN, sDesc, 1024, iLenDesc)
 
            bContinue = True
        End If
 
        If Trim(sDSN) = "" Then nRet = 0
 
        If nRet <> 0 Then
            sDSNString = Mid(sDSN, 1, iLenDSN)
            sDSNString = sDSNString & ":" & Mid(sDesc, 1, iLenDesc)
            DSNList.Add sDSNString
        End If
 
    Loop While iLenDSN <> 0 And nRet <> 0
 
    SQLFreeEnv hSQL
 
End Function
 
Public Sub GetDrivers(sCol As Collection)
    Dim sBuffer As String
    Dim nRet As Long
    Dim iBufSize As Integer
    Dim sDriver As String
    Dim i As Long
 
    sBuffer = Space(1024)
 
    nRet = SQLGetInstalledDrivers(sBuffer, 1024, iBufSize)
 
    sBuffer = Left$(sBuffer, iBufSize)
 
    sDriver = ""
    For i = 1 To Len(sBuffer)
        If Mid$(sBuffer, i, 1) = vbNullChar Then
            If Trim(sDriver) <> "" Then sCol.Add sDriver
            sDriver = ""
        Else
            sDriver = sDriver & Mid$(sBuffer, i, 1)
        End If
    Next i
 
End Sub
 
Public Function CheckDSN(sName As String, sDriverPart As String)
    Dim SysDSN As New Collection
    Dim eintrag As Variant
    Dim DSNName As String
    Dim Driver As String
 
    EnumDSNs SysDSN
 
    CheckDSN = False
    For Each eintrag In SysDSN
        DSNName = Left$(eintrag, InStr(eintrag, ":") - 1)
        Driver = Mid$(eintrag, InStr(eintrag, ":") + 1)
        If DSNName = sName And InStr(Driver, sDriverPart) <> 0 Then
            CheckDSN = True
        End If
    Next eintrag
End Function