Option Explicit
 
' benötigte Deklarationen
Private Declare Function SQLAllocEnv Lib "odbc32.dll" ( _
  ByRef env As Long) As Integer
 
Private Declare Function SQLDataSources Lib "odbc32.dll" ( _
  ByVal henv As Long, _
   ByVal fDirection As Integer, _
   ByVal szDSN As String, _
   ByVal cbDSNMax As Integer, _
   pcbDSN As Integer, _
   ByVal szDescription As String, _
   ByVal cbDescriptionMax As Integer, _
   pcbDescription As Integer) As Integer
 
Private Declare Function SQLFreeEnv Lib "odbc32.dll" ( _
  ByVal henv As Long) As Integer
 
Private Const SQL_SUCCESS = 0
Private Const SQL_FETCH_FIRST_SYSTEM = 32
Private Const SQL_FETCH_NEXT = 1
 
' Struktur für die Rückgabe der DSN-Einträge
Public Type tDSN
  DSNName As String
  Description As String
End Type
 
' alle vorhandenen System-DSN Einträge ermitteln
Public Function GetAllSystemDSN(ByRef DSN() As tDSN) As Long
  Dim nResult As Integer
  Dim nHandle As Long
  Dim sDSN As String
  Dim sDescr As String
  Dim nLenDSN As Integer
  Dim nDescrLen As Integer
  Dim nCount As Long
 
  nCount = 0
 
  ' Handle ermitteln
  nResult = SQLAllocEnv(nHandle)
  If nResult <> -1 Then
    ' ersten System DSN Eintrag ermitteln
    sDSN = Space$(1024)
    sDescr = Space$(1024)
    nResult = SQLDataSources(nHandle, SQL_FETCH_FIRST_SYSTEM, _
      sDSN, Len(sDSN), nLenDSN, sDescr, Len(sDescr), nDescrLen)
 
    If nResult = SQL_SUCCESS Then
      ' Rückgabe in tDSN-Struktur schreiben
      nCount = nCount + 1
      ReDim Preserve DSN(nCount - 1)
      With DSN(nCount - 1)
        .DSNName = Left$(sDSN, nLenDSN)
        .Description = Left$(sDescr, nDescrLen)
      End With
 
      ' jetzt nach weiteren Einträgen suchen
      Do Until nResult <> SQL_SUCCESS
        nResult = SQLDataSources(nHandle, SQL_FETCH_NEXT, _
          sDSN, Len(sDSN), nLenDSN, sDescr, Len(sDescr), nDescrLen)
        If nResult = SQL_SUCCESS Then
          ' Rückgabewert wieder in tDSN-Struktur speichern
          nCount = nCount + 1
          ReDim Preserve DSN(nCount - 1)
          With DSN(nCount - 1)
            .DSNName = Left$(sDSN, nLenDSN)
            .Description = Left$(sDescr, nDescrLen)
          End With
        End If
      Loop
    End If
  End If
 
  ' Ressourcen wieder freigeben
  SQLFreeEnv nHandle
 
  ' nCount = Anzahl gefundener Einträge
  GetAllSystemDSN = nCount
End Function

Dim DSN() As tDSN
Dim nCount As Long
 
nCount = GetAllSystemDSN(DSN())
If nCount > 0 Then
  Dim i As Long
  For i = 0 To nCount - 1
    Combo1.AddItem DSN(i).DSNName
  Next i
End If

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de