Question : Creating an ODBC connection via VBA utilizing a generic username and password

i have created the following code to automatically set up an ODBC connection in my access database. this code works great if i use the trusted connection option but when i try and give it a generic user name and password it fails. Anyone know what i am doing wrong?

PS i have manually set up the user name and password and they work just fine

Code Snippet:

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:

           
           
             Option Compare Database
 
Option Explicit
 
'Const ODBC_ADD_SYS_DSN = 1      'Add a user data source
Const ODBC_CONFIG_SYS_DSN = 2    'Configure (edit) data source
Const ODBC_REMOVE_SYS_DSN = 3    'Remove data source
Const ODBC_ADD_SYS_DSN = 4       'Add a system data source
 
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
                    
 
Function Build_SystemDSN()
  
    Dim Driver As String
    Dim Ret As Long
    Dim Attributes As String
 
    Driver = "SQL Server"
    'attributes are the connection information
    
    Attributes = "server=ANSRLTR" & Chr(0)
    Attributes = Attributes & "DSN=DSN_Temp" & Chr(0)
    Attributes = Attributes & "Database=ANSRLTR_Prod" & Chr(0)
    'use this line if you want to use the users name and password
    'Attributes = Attributes & "Trusted_Connection=Yes" & Chr(0)
    'use this line if you are adding a username and password
    Attributes = Attributes & "Uid=Temp;" & Chr(0) & "Pwd=TempID" & Ch(0)
 
      Ret = SQLConfigDataSource(0, ODBC_ADD_SYS_DSN, Driver, Attributes)
   
   
   'ret is equal to 1 on success and 0 if there is an error
   If Ret <> 1 Then
       MsgBox "DSN Creation Failed"
   End If
 
 
End Function

           
         

Open in New Window Select All

Answer : Creating an ODBC connection via VBA utilizing a generic username and password

i can have a work around:
create the dns manually by register base (in vba, see my vbs code in snippet)
then use it just after

i include the register key to create a connection called sql01

this is taken from a VBS file
so you might have to dim the objects and variables in VBA
also change it to create a access connection

but now your level work against you, so i let you some work to do :P

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:

           
           
             Set objshe = WScript.CreateObject("WScript.Shell")  
 
    a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\Driver"
      d=regwri(a,"%windir%\system32\SQLSRV32.dll","REG_SZ")
      a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\Description"
      d=regwri(a,"sql01","REG_SZ")
      a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\Server"
      d=regwri(a,"sql.corp.stas.local","REG_SZ")
      a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\UID"
      d=regwri(a,usenam,"REG_SZ")
      a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\Trusted_Connection"
      d=regwri(a,"Yes","REG_SZ")
      '=== créer un path sans valeur "\" at end, c = "" (type)
      a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\Engines\"
      d=regwri(a,"","")
      a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC Data Sources\sql01"
      d=regwri(a,"SQL server","REG_SZ")
 
'====== write a value in registry, trap error
function regwri(regkey, value, type01)
   if type01<>"" then
      on error resume next
      objshe.RegWrite regkey,value,type01
   else
      objshe.RegWrite regkey,""
   end if
   if err.number<>0 then
      'msgfin = msgfin & "`n" & regkey & "`n"
      toterrcop = toterrcop + 1
      msgfin03 = msgfin03 & vbcrlf & "error - register base not written: " & vbcrlf & regkey & vbcrlf & err.description & vbcrlf
      if usenam = debugname then
         'msgbox("cannot write key" & vbcrlf & regkey & vbcrlf & value)
      end if
   end if
end function

           
         

Open in New Window Select All