How to programmatically create an Access DSN

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.

By the way, if you got or are getting value from the VBA information, please give me a tip, thanks!