by Majid Akhtar Javid (1 Submission)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 26th July 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This code is used to created/Deleted runtime DSN-ODBC for Access/SQL-Server. Please Vote this code. The code is tested and working perfectly
VBcoders
Option Explicit
Public strdsn As String
Public StrDesc As String
Public StrServer As String
'RepPath =
Public StrPath As String
'------------------------For Creating SQL Server DSN
Public Enum REG_TOPLEVEL_KEYS
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_CURRENT_USER = &H80000001
HKEY_DYN_DATA = &H80000006
HKEY_LOCAL_MACHINE = &H80000002
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_USERS = &H80000003
End Enum
Private Declare Function RegCreateKey Lib _
"advapi32.dll" Alias "RegCreateKeyA" _
(ByVal Hkey As Long, ByVal lpSubKey As _
String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib _
"advapi32.dll" (ByVal Hkey As Long) As Long
Private 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 Long
Private Const REG_SZ = 1
'PURPOSE: To create a registry key
'Const HKEY_CLASSES_ROOT = &H80000000
'Const HKEY_CURRENT_USER = &H80000001
'Const HKEY_LOCAL_MACHINE = &H80000002
'Const HKEY_USERS = &H80000003
Const ERROR_NONE = 0
Const ERROR_BADDB = 1
Const ERROR_BADKEY = 2
Const ERROR_CANTOPEN = 3
Const ERROR_CANTREAD = 4
Const ERROR_CANTWRITE = 5
Const ERROR_OUTOFMEMORY = 6
Const ERROR_INVALID_PARAMETER = 7
Const ERROR_ACCESS_DENIED = 8
Const ERROR_INVALID_PARAMETERS = 87
Const ERROR_NO_MORE_ITEMS = 259
Const KEY_ALL_ACCESS = &H3F
Const REG_OPTION_NON_VOLATILE = 0
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" _
Alias "RegCreateKeyExA" (ByVal Hkey As Long, _
ByVal lpSubKey As String, ByVal Reserved As Long, _
ByVal lpClass As String, ByVal dwOptions As Long, _
ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, _
phkResult As Long, lpdwDisposition As Long) As Long
'-----------------------------------------------------------------
'------------------------------Remove User DSN of Access----------
'Constant Declaration
Private Const ODBC_ADD_DSN = 1 ' Add data source
Private Const ODBC_CONFIG_DSN = 2 ' Configure (edit) data source
Private Const ODBC_REMOVE_DSN = 3 ' Remove data source
Private Const vbAPINull As Long = 0& ' NULL Pointer
'Function Declare
#If Win32 Then
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
#Else
Private Declare Function SQLConfigDataSource Lib "ODBCINST.DLL" _
(ByVal hwndParent As Integer, ByVal fRequest As Integer, ByVal _
lpszDriver As String, ByVal lpszAttributes As String) As Integer
#End If
'-----------------------------------------------------------------
Public Sub Create_ODBC()
' CREATE THE DSN
'***********************
Dim strAttributes As String
Dim att As String
att = "Description=" & StrDesc & Chr$(13)
att = att & "PWD=majid735" & Chr$(13)
att = att & "DBQ=" & StrPath
RegisterDatabase strdsn, "Microsoft Access Driver (*.mdb)", True, att
End Sub
Sub FormLoad()
Dim a As String
On Error Resume Next
strdsn = "Movie"
StrDesc = "Movie Package"
StrPath = App.Path & "\Movie.mdb"
'************************************************************
' THIS FUNCTION TO CREATE THE DATABASE NAME
Call Create_ODBC
'*************************************************************
End Sub
Public Sub DeleteDSN()
Dim strAttributes As String
Dim att As String
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 String
Dim lResult As Long
Dim hKeyHandle As Long
'----------------------Check if there is some DSN then delete it
#If Win32 Then
Dim intRet As Long
#Else
Dim intRet As Integer
#End If
Dim strDriver As String
'Set the driver to SQL Server because most common.
strDriver = "Microsoft Access Driver (*.mdb)"
'Set the attributes delimited by null.
'See driver documentation for a complete list of attributes.
strAttributes = "DSN=Accounts" & Chr$(0)
'To show dialog, use Form1.Hwnd instead of vbAPINull.
intRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, _
strDriver, strAttributes)
If intRet Then
MsgBox "DSN Deleted"
Else
MsgBox "Delete Failed"
End If
End Sub
No comments have been posted about This code is used to created/Deleted runtime DSN-ODBC for Access/SQL-Server. Please Vote this code.. Why not be the first to post a comment about This code is used to created/Deleted runtime DSN-ODBC for Access/SQL-Server. Please Vote this code..
