Как я могу перечислить список DSN, настроенных на компьютере с помощью VBA?

У меня есть приложение Excel, в котором я хочу представить пользователю список имен источников данных (например, DSN), посредством которых он/она может выбрать, какой источник данных использовать.

Надеюсь, когда у меня появится список, я могу легко получить доступ к свойствам DSN для подключения к соответствующей базе данных.

Обратите внимание: я не хочу использовать соединение без DSN.

3 ответа

Записи DSN хранятся в реестре в следующих ключах.

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

Здесь содержится список всех определенных DSN. Это действует как глобальный индекс, и конкретные данные для каждого DSN хранятся в ключе с именем DSN в разделе:

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

Создайте некоторые записи на вкладках User DSN и System DSN из апплета панели управления данными (ODBC) и проверьте, как эти значения хранятся в реестре.

Следующий пример перечисляет DSN, определенный для пользовательской панели управления > Административные средствa > Источники данных (ODBC) [вкладка User 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


Вы можете использовать функцию SQLDataSources API ODBC. См. Документация MSDN.


Чрезвычайно крутое решение. Я столкнулся с проблемой, когда CURRENT_USER не показывал все DSN, конечно, не тот, который мне нужен. Я изменил его на LOCAL_MACHINE и увидел все DSN, которые появились в диспетчере подключений, включая подмножество, появившееся под CURRENT_USER.

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

licensed under cc by-sa 3.0 with attribution.