Maybe this code will solve the problem.
'API Constants
Private Const SQL_SUCCESS As Long = 0
Private Const SQL_FETCH_NEXT As Long = 1
'APIs
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 SQLAllocEnv Lib "ODBC32.DLL" (env As Long) _
As Integer
'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*
' Routine: EnumerateDSNs
' Description: Fills the cb (either ComboBox or ListBox) with
' a list of ODBC DSNs
' Parameters: cb (required) - either ComboBox or ListBox to fill
' sDriver (optional) - specific DNS type filter
' (i.e. 'SQL Server')
' Created by: Serge Baranovsky
' Date-Time: 6/17/99 11:15:53 AM
' Last modification:
'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*
Public Sub EnumerateDSNs(cb As Control, Optional sDriver As String = "" )
Dim nRC As Integer
Dim sDSNItem As String * 1024
Dim sDRVItem As String * 1024
Dim sDSN As String
Dim sDRV As String
Dim nDSNLen As Integer
Dim nDRVLen As Integer
Dim lHenv As Long 'handle to the environment
Dim bFilter As Boolean
On Error Resume Next
If sDriver <> "" Then bFilter = True
'get the DSNs
If SQLAllocEnv(lHenv) <> -1 Then
Do Until nRC <> SQL_SUCCESS
sDSNItem = Space(1024)
sDRVItem = Space(1024)
nRC = SQLDataSources(lHenv, SQL_FETCH_NEXT, sDSNItem, 1024, _
nDSNLen, sDRVItem, 1024, nDRVLen)
sDSN = Left(sDSNItem, nDSNLen)
sDRV = Left(sDRVItem, nDRVLen)
If sDSN <> Space(nDSNLen) Then
If bFilter Then
If sDRV = sDriver Then cb.AddItem sDSN
Else
cb.AddItem sDSN
End If
End If
Loop
End If
End Sub