Option Explicit Private Const REG_SZ = 1 'Constant for a string variable type. Private Const HKEY_LOCAL_MACHINE = &H80000002Private Declare Function RegCreateKey Lib "advapi32.dll" Alias _ "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, _ phkResult As Long) As LongPrivate Declare Function RegSetValueEx Lib "advapi32.dll" Alias _ "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _ ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal _ cbData As Long) As LongPrivate Declare Function RegCloseKey Lib "advapi32.dll" _ (ByVal hKey As Long) As Long Private Sub Command1_Click()Dim DataSourceName As String Dim DatabaseName As String Dim Description As String Dim DriverPath As String Dim DriverName As String Dim LastUser As String Dim Regional As String Dim Server As StringDim lResult As Long Dim hKeyHandle As Long'Specify the DSN parameters.DataSourceName = "DeD"DatabaseName = "databasename" Description = "sdafasf" DriverPath = "" LastUser = "sa" Server = "youserver" DriverName = "SQL Server"'Create the new DSN key.lResult = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & _ DataSourceName, hKeyHandle)'Set the values of the new DSN key.lResult = RegSetValueEx(hKeyHandle, "Database", 0&, REG_SZ, _ ByVal DatabaseName, Len(DatabaseName)) lResult = RegSetValueEx(hKeyHandle, "Description", 0&, REG_SZ, _ ByVal Description, Len(Description)) lResult = RegSetValueEx(hKeyHandle, "Driver", 0&, REG_SZ, _ ByVal DriverPath, Len(DriverPath)) lResult = RegSetValueEx(hKeyHandle, "LastUser", 0&, REG_SZ, _ ByVal LastUser, Len(LastUser)) lResult = RegSetValueEx(hKeyHandle, "Server", 0&, REG_SZ, _ ByVal Server, Len(Server))'Close the new DSN key.lResult = RegCloseKey(hKeyHandle)'Open ODBC Data Sources key to list the new DSN in the ODBC Manager. 'Specify the new value. 'Close the key.lResult = RegCreateKey(HKEY_LOCAL_MACHINE, _ "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", hKeyHandle) lResult = RegSetValueEx(hKeyHandle, DataSourceName, 0&, REG_SZ, _ ByVal DriverName, Len(DriverName)) lResult = RegCloseKey(hKeyHandle) Dim cn As ADODB.Connection Set cn = New ADODB.Connection With cn .ConnectionString = "DSN=DeD" .Open End With End Sub
你可以去找一下。
连接到ACCESS的DSN可以成功。
接到SQL SERVER的DSN失败(DSN中要包括UID和PWD)。
Private Const REG_SZ = 1 'Constant for a string variable type.
Private Const HKEY_LOCAL_MACHINE = &H80000002Private Declare Function RegCreateKey Lib "advapi32.dll" Alias _
"RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, _
phkResult As Long) As LongPrivate Declare Function RegSetValueEx Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal _
cbData As Long) As LongPrivate Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Sub Command1_Click()Dim DataSourceName As String
Dim DatabaseName As String
Dim Description As String
Dim DriverPath As String
Dim DriverName As String
Dim LastUser As String
Dim Regional As String
Dim Server As StringDim lResult As Long
Dim hKeyHandle As Long'Specify the DSN parameters.DataSourceName = "DeD"DatabaseName = "databasename"
Description = "sdafasf"
DriverPath = ""
LastUser = "sa"
Server = "youserver"
DriverName = "SQL Server"'Create the new DSN key.lResult = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & _
DataSourceName, hKeyHandle)'Set the values of the new DSN key.lResult = RegSetValueEx(hKeyHandle, "Database", 0&, REG_SZ, _
ByVal DatabaseName, Len(DatabaseName))
lResult = RegSetValueEx(hKeyHandle, "Description", 0&, REG_SZ, _
ByVal Description, Len(Description))
lResult = RegSetValueEx(hKeyHandle, "Driver", 0&, REG_SZ, _
ByVal DriverPath, Len(DriverPath))
lResult = RegSetValueEx(hKeyHandle, "LastUser", 0&, REG_SZ, _
ByVal LastUser, Len(LastUser))
lResult = RegSetValueEx(hKeyHandle, "Server", 0&, REG_SZ, _
ByVal Server, Len(Server))'Close the new DSN key.lResult = RegCloseKey(hKeyHandle)'Open ODBC Data Sources key to list the new DSN in the ODBC Manager.
'Specify the new value.
'Close the key.lResult = RegCreateKey(HKEY_LOCAL_MACHINE, _
"SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", hKeyHandle)
lResult = RegSetValueEx(hKeyHandle, DataSourceName, 0&, REG_SZ, _
ByVal DriverName, Len(DriverName))
lResult = RegCloseKey(hKeyHandle)
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
With cn
.ConnectionString = "DSN=DeD"
.Open
End With
End Sub