Membuat ODBC Secara Otomatis

Private Sub Form_Load()

On Error Resume Next
DSN "Add", "Microsoft Access Driver (*.mdb)", "nama ODBC", App.Path + "\nama database", "Han's programming DSN"
Set CN = New ADODB.Connection

CN.Open "Provider=MSDASQL.1;Password=coklat;Persist Security Info=True;User ID=Administrator;Data Source=nama ODBC"
KeyPreview = True

Private Const ODBC_ADD_SYS_DSN = 4 'Constant for Adding the DSN
Private Const ODBC_REMOVE_SYS_DSN = 6 'Constant for removing the DSN
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const SW_ShowNormal = 1
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long
'Public Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As meminfo_status)
'Public COM_RS As New ADODB.Recordset '(SeARCH RESULT)
Public Function DSN(DoWhat As String, DriverName As String, DSNName As String, DataBasesName As String, Description As String)
Dim Added As Byte

If DoWhat = "Add" Then
Added = SQLConfigDataSource(0, ODBC_ADD_SYS_DSN, DriverName & Chr(0), "DSN=" & DSNName & Chr(0) & "Uid=Admin" & Chr(0) & "pwd=" & Chr(0) & "DBQ=" & DataBasesName & Chr(0) & "Description=" & Description & Chr(0))

If Added = 0 Then 'Error code 0 means something went wrong and the SQLConfigDataSource Never finished
MsgBox "This program may not work on this PC. Contact the vendor with Error Code: 275", vbOKOnly, "Error"
ElseIf Added = 1 Then 'Error code 1 means SQLConfigDataSource finished successfully
'MsgBox "DSN Added Successfully!", vbOKOnly, "Success!"
End If

ElseIf DoWhat = "Del" Then
Added = SQLConfigDataSource(0, ODBC_REMOVE_SYS_DSN, DriverName & Chr(0), "DSN=" & DSNName & Chr(0) & "Uid=Admin" & Chr(0) & "pwd=" & Chr(0) & "DBQ=" & DataBasesName & Chr(0) & "Description=" & Description & Chr(0))

If Added = 0 Then
MsgBox "Error Deleting DSN", vbOKOnly, "Error"
ElseIf Added = 1 Then
MsgBox "DSN Deleted Successfully!", vbOKOnly, "Success!"
End If
End If
End Function