How to programmatically create an Access DSN
by admin on Tuesday, February 12th, 2019 | No Comments
When I was working on a project at Exxon, I had to load Access on startup to connect to a DSN.
Here is how I implemented it (I don’t remember where I found the code):
Private Sub Form_Open(Cancel As Integer) '#####================================================================================ '## '## '## Purpose: '## For use in scripts that require SQL System DSNs (setup and pre-req check) '## 1. Checks if SQL System DSN exists if not, exits '## 2. Creates SQL System DSN by running /Setup and prompt user for values (or uses defaults) '## '## Requirements: '## 1. Must have administrative permissions to create SQL system DSN. '## 2. Change Const DSN: DSN="Your DSN Name" '## '## Basic Logic: '## 1. Checks to see if your SQL System DSN exists '## 2. If you run the script with /Setup, script will prompt you for values and creates SQL system DSN '#####================================================================================ Dim strMsg As String On Error Resume Next Const DSN = "my_intranet" If Not DSNExists(DSN) Then strMsg = vbNewLine & "***Failed Pre-Req. A SQL system DSN must first exist to 'RMH Intranet DB', " & _ "use /Setup to create one*** (or one will be created automatically)" MsgBox strMsg Setup Wscript.Quit End If End Sub Sub Setup() 'DESC: Creats a System DSN to database Dim strDataSourceName: strDataSourceName = "my_intranet" 'InputBox("Enter Data Source Name", "Data Source Name", "MY_DATABASE_DSN") Dim strSQLServer: strSQLServer = "192.168.1.2" 'InputBox("Enter SQL Server Name", "SQL Server", "SQL001") Dim strDescription: strDescription = "My Intranet DB" ' InputBox("Enter Description", "Description", "DSN to MY DATABASE") Dim strDataBaseName: strDataBaseName = "my_test" ' InputBox("Enter Database Name", "Database", "MY_DATABASE") 'Set Values Const SystemFolder = 1 Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject") Dim strSysPath: strSysPath = objFSO.GetSpecialFolder(SystemFolder) Dim strDriverName: strDriverName = "MySQL ODBC 3.51 Driver" Dim strDriverPath: strDriverPath = strSysPath & "\sqlsrv32.dll" Dim strTrustedConnection: strTrustedConnection = "Yes" Dim strRegPath: strRegPath = "HKCU\SOFTWARE\ODBC\ODBC.INI\" & strDataSourceName & "\" Dim objWshNetwork: Set objWshNetwork = CreateObject("WScript.Network") Dim strLastUser: strLastUser = objWshNetwork.UserName Dim objWshShell: Set objWshShell = CreateObject("Wscript.Shell") 'Create Key objWshShell.RegWrite strRegPath, "" 'Create Values objWshShell.RegWrite strRegPath & "Database", strDataBaseName objWshShell.RegWrite strRegPath & "Description", strDescription objWshShell.RegWrite strRegPath & "Driver", strDriverName objWshShell.RegWrite strRegPath & "LastUser", strLastUser objWshShell.RegWrite strRegPath & "Server", strSQLServer objWshShell.RegWrite strRegPath & "Trusted_Connection", strTrustedConnection objWshShell.RegWrite "HKCU\SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources\" & strDataSourceName, strDriverName MsgBox "MySQL System DSN: " & strDataSourceName & " has been created" Set objFSO = Nothing Set objWshNetwork = Nothing Set objWshShell = Nothing Wscript.Quit End Sub Function DSNExists(strValueName) Dim strComputer: strComputer = "." Dim objReg: Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & _ "\root\default:StdRegProv") Dim strKeyPath: strKeyPath = "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources" Const HKEY_CLASSES_ROOT = &H80000000 Const HKEY_CURRENT_USER = &H80000001 Const HKEY_LOCAL_MACHINE = &H80000002 Const HKEY_USERS = &H80000003 Const HKEY_CURRENT_CONFIG = &H80000005 Dim strDWValue objReg.GetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strDWValue If strDWValue <> "" Then DSNExists = vbTrue Else DSNExists = vbFalse End If End Function
Let me know if you have any questions.