Create new ODBC setting programmatically

[MattDavies51]

I have borrowed code from other threads concerning this issue. However there seems to be a problem when specifying SQL Server login authentication in that the Data source is not created. Does anyone know a way around this, without removing the Login ID and Password?

Here is my code:

Module:

Option Explicit

Private Const SQL_SUCCESS As Long = 0 ' ODBC Success
Private Const SQL_ERROR As Long = -1 ' ODBC Error
Private Const SQL_FETCH_NEXT As Long = 1 ' ODBC Move Next

Private Declare Function SQLDataSources Lib "ODBC32.DLL" _
(ByVal hEnv As Long, ByVal fDirection _
As Integer, ByVal szDSN As String, _
ByVal cbDSNMax As Integer, pcbDSN As Integer, _
ByVal szDescription As String, ByVal cbDescriptionMax _
As Integer, pcbDescription As Integer) As Integer

Private Declare Function SQLAllocEnv Lib "ODBC32.DLL" _
(env As Long) As Integer

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

Private Const ODBC_ADD_SYS_DSN = 4
'
Public Sub GetDSNs()
Dim intRetCode As Integer ' the return code
Dim strDSNItem As String ' the dsn name
Dim strDRVItem As String ' the driver name
Dim strDSN As String ' the formatted dsn name
Dim intDSNLen As Integer ' the length of the dsn name
Dim intDRVLen As Integer ' the length of the driver name
Dim hEnv As Long ' handle to the environment
Dim strTemp As String ' Tempspace
Dim strDSNTemp As String ' Tempspace
Dim int_Ct As Integer
Dim int_Ct2 As Integer
Dim str_DSN_Hold() As String

' On Error Resume Next

ReDim str_DSN_Hold(0 To 5000)

If (SQLAllocEnv(hEnv) <> SQL_ERROR) Then
Do

strDSNItem = Space$(1024)
strDRVItem = Space$(1024)

intRetCode = SQLDataSources(hEnv, SQL_FETCH_NEXT, strDSNItem, _
Len(strDSNItem), intDSNLen, strDRVItem, _
Len(strDRVItem), intDRVLen)

strDSN = Left$(strDSNItem, intDSNLen)

If UCase(Mid$(strDRVItem, 1, 10)) = &quot;SQL SERVER&quot; Or _
UCase(Mid$(strDRVItem, 1, 23)) = &quot;MICROSOFT ACCESS DRIVER&quot; Then
str_DSN_Hold(int_Ct) = &quot;&quot;
For int_Ct2 = 1 To Len(Trim$(strDSNItem))
If Asc(Mid$(strDSNItem, int_Ct2, 1)) >= 32 And Asc(Mid$(strDSNItem, int_Ct2, 1)) < 127 Then
str_DSN_Hold(int_Ct) = str_DSN_Hold(int_Ct) + Mid$(strDSNItem, int_Ct2, 1)
End If
Next int_Ct2

int_Ct = int_Ct + 1
End If

Loop Until intRetCode <> SQL_SUCCESS
End If

ReDim g_str_DSN(0 To int_Ct - 1)

For int_Ct = 0 To UBound(g_str_DSN)
g_str_DSN(int_Ct) = str_DSN_Hold(int_Ct)
Next int_Ct

End Sub

Public Function CreateSQLServerDSN(DSNName As String, Description As String, ServerName As String, Database As String) As Boolean
Dim sAttributes As String

sAttributes = &quot;DSN=&quot; & DSNName & Chr(0)
sAttributes = sAttributes & &quot;Server=&quot; & ServerName & Chr(0)
sAttributes = sAttributes & &quot;Database=&quot; & Database & Chr(0)
sAttributes = sAttributes & &quot;Trusted_Connection=No&quot; & Chr(0)
'These ones break things...
sAttributes = sAttributes & &quot;UID=printlogin&quot; & Chr(0)
sAttributes = sAttributes & &quot;PWD=printlogin&quot; & Chr(0)

CreateSQLServerDSN = CreateDSN(&quot;SQL Server&quot;, sAttributes)

End Function

Public Function CreateDSN(Driver As String, Attributes As String) As Boolean
CreateDSN = SQLConfigDataSource(0&, ODBC_ADD_SYS_DSN, Driver, Attributes)
End Function




Form:

Private Sub Command1_Click()
If CreateSQLServerDSN(&quot;test&quot;, &quot;Description&quot;, &quot;lonsql2&quot;, &quot;printlogin&quot Then
MsgBox &quot;successful&quot;
GetDSNs
Else
MsgBox &quot;failed&quot;
End If
End Sub