Comment puis-je énumérer la liste des DSN configurés sur un ordinateur en utilisant VBA?

Question

J'ai une application Excel dans laquelle je souhaite présenter à l'utilisateur une liste des noms de sources de données (DSN), ce qui lui permet de choisir la source de données à utiliser.

J'espère qu'une fois que j'ai la liste, je peux facilement accéder aux propriétés DSN pour me connecter à la base de données appropriée.

Veuillez noter, je fais pas voulez utiliser une connexion sans DSN.

Answer 1

Les entrées DSN sont stockées dans le registre dans les clés suivantes.

HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC Data Sources 
HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources

Ceci contient la liste de tous les DSN définis. Cela agit comme un indice global et les détails spécifiques pour chaque source de données sont stockées dans une clé avec le nom de DSN sous:

HKEY_CURRENT_USER\Software\ODBC\ODBC.INI 
HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI

Créer des entrées dans les deux utilisateur onglets DSN DSN et système de sources de données (ODBC) panneau de commande applet et vérifiez comment ces valeurs sont stockées dans le registre.

L'exemple suivant énumère le DSN défini pour l'utilisateur via le Panneau de configuration> Outils d'administration> Sources de données (ODBC) [Onglet Utilisateur Dsn].

http://support.microsoft.com/kb/178755

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 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 Function RegCloseKey Lib "advapi32.dll" _ 
     (ByVal hKey As Long) As Long 

    Const HKEY_CLASSES_ROOT = &H80000000 
    Const HKEY_CURRENT_USER = &H80000001 
    Const HKEY_LOCAL_MACHINE = &H80000002 
    Const HKEY_USERS = &H80000003 

    Const ERROR_SUCCESS = 0& 

    Const SYNCHRONIZE = &H100000 
    Const STANDARD_RIGHTS_READ = &H20000 
    Const STANDARD_RIGHTS_WRITE = &H20000 
    Const STANDARD_RIGHTS_EXECUTE = &H20000 
    Const STANDARD_RIGHTS_REQUIRED = &HF0000 
    Const STANDARD_RIGHTS_ALL = &H1F0000 
    Const KEY_QUERY_VALUE = &H1 
    Const KEY_SET_VALUE = &H2 
    Const KEY_CREATE_SUB_KEY = &H4 
    Const KEY_ENUMERATE_SUB_KEYS = &H8 
    Const KEY_NOTIFY = &H10 
    Const KEY_CREATE_LINK = &H20 
    Const KEY_READ = ((STANDARD_RIGHTS_READ Or _ 
        KEY_QUERY_VALUE Or _ 
        KEY_ENUMERATE_SUB_KEYS Or _ 
        KEY_NOTIFY) And _ 
        (Not SYNCHRONIZE)) 

    Const REG_DWORD = 4 
    Const REG_BINARY = 3 
    Const REG_SZ = 1 

    Private Sub Command1_Click() 
    Dim lngKeyHandle As Long 
    Dim lngResult As Long 
    Dim lngCurIdx As Long 
    Dim strValue As String 
    Dim lngValueLen As Long 
    Dim lngData As Long 
    Dim lngDataLen As Long 
    Dim strResult As String 

    lngResult = RegOpenKeyEx(HKEY_CURRENT_USER, _ 
      "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", _ 
       0&, _ 
       KEY_READ, _ 
       lngKeyHandle) 

    If lngResult <> ERROR_SUCCESS Then 
     MsgBox "Cannot open key" 
     Exit Sub 
    End If 

    lngCurIdx = 0 
    Do 
     lngValueLen = 2000 
     strValue = String(lngValueLen, 0) 
     lngDataLen = 2000 

     lngResult = RegEnumValue(lngKeyHandle, _ 
           lngCurIdx, _ 
           ByVal strValue, _ 
           lngValueLen, _ 
           0&, _ 
           REG_DWORD, _ 
           ByVal lngData, _ 
           lngDataLen) 
     lngCurIdx = lngCurIdx + 1 

     If lngResult = ERROR_SUCCESS Then 
      strResult = strResult & lngCurIdx & ": " & Left(strValue, lngValueLen) & vbCrLf 
     End If 
    Loop While lngResult = ERROR_SUCCESS 
    Call RegCloseKey(lngKeyHandle) 

    Call MsgBox(strResult, vbInformation) 
    End Sub 

Answer 2

Vous pouvez utiliser la fonction de SQLDataSources de l'API ODBC. Voir MSDN documentation.

Answer 3

Solution extrêmement fraîche. J'ai rencontré un problème où CURRENT_USER ne montrait pas tous les DSN, certainement pas celui dont j'avais besoin. Je l'ai changé en LOCAL_MACHINE et j'ai vu tous les DSN qui apparaissaient dans le Connection Manager, y compris le sous-ensemble qui apparaissait sous CURRENT_USER.

http://msdn.microsoft.com/en-us/library/windows/desktop/ms712603(v=vs.85).aspx