Creating a DSN with VBA

try this

http://support.microsoft.com/kb/171146/EN-US/

Hi Cyber-Drugs,

This is an example from another Access support forum.  I have never used it myself.

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

Sub Main()

Dim intret As Long
Dim atts As String
Dim strdriver As String

strdriver = "Microsoft Text Driver (*.txt; *.csv)"
atts = "DSN=" & "Text Files"
intret = SQLConfigDataSource(0, 1, strdriver, atts)

If intret Then
    Msgbox("DSN created sucessfully")
Else
    MsgBox ("There was a problem setting up the DSN, please contact support")
End If

End Sub


Pete

from the first link
when u copy, one line is

Private Const vbAPINull As Long = 0&  ' NULL Pointer


I guess u need to change this to


Private Const vbAPINull As Long = 0   ' NULL Pointer

which database do u want?

Whichever one, u need to ensure you have the right driver name specified

I guess when u manually add a ODBC driver, u can see what drivers there are, so just pick one of them

An alternative way is to create an entry in the registry

http://www.andreavb.com/forum/viewtopic.php?TopicID=677

But I'd stick with the API call as mentioned in that link

rockiroads, that looks like it's what I need, but it looks like it's for regular VB, and not for Access VBA, or will or work in VBA?

yes it does, I just tried it

Generally a lot of VB code that uses API works well with VBA so there isnt a problem

Do remember to make that one line change though

here is one I just created for Microsoft Oracle driver


'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 AddDSN()
   
    #If Win32 Then
        Dim intRet As Long
    #Else
        Dim intRet As Integer
    #End If
    Dim strDriver As String
    Dim strAttributes As String
    Dim sTNSName as String
   
    strDriver = "Microsoft ODBC For Oracle"
   
    'THIS IS MY TNS NAMES ENTRY
    sTNSName = "ORA123"

    strAttributes = "SERVER=" & sTNSName & Chr$(0)
    strAttributes = strAttributes & "DESCRIPTION=Auto Generated VBA" & Chr$(0)             'free text
    strAttributes = strAttributes & "DSN=MY_ORACLE_BABY" & Chr$(0)                             'the name for your DSN
   
    intRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, strDriver, strAttributes)
    If intRet Then
        MsgBox "DSN Created"
    Else
        MsgBox "Create Failed"
    End If

End Sub





the one I used from the MS example also created a SQL Server entry

OK, so this is what I want to use?




 Option Explicit

 Private Const REG_SZ = 1    'Constant for a string variable type.
 Private Const HKEY_LOCAL_MACHINE = &H80000002

 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 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 Declare Function RegCloseKey Lib "advapi32.dll" _
    (ByVal hKey As Long) As Long

Public Sub AddDSN()
   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

   'Specify the DSN parameters.

   DataSourceName = "JustinDNS"
   DatabaseName = "localhost"
   Description = "My DSN Description"
   DriverPath = "localhost"
   LastUser = "administrator"
   Server = "localhost"
   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)
End Sub











Please let me know if any of that is wrong, and how will I know if it has connected successfully, will a msg box appear? If not, can I make a box appear?


Cheers guys!

That works and has created a System DSN, but I dont have SQL Server DB (even though I have the oDBC drivers) so I can test connectivity

but u can test it if u go into ODBC config, then edit your newly created DSN and click Next to validate the settings - this should also attempt to login

Perfecto, cheers again rockiroads! :)