Well, I found the solution. Place the code below in a module and then you can call the functions from anywhere.
Public Enum DSNType
CreateUserDSN& = 1 ' Add User data source
ModifyUserDSN& = 2 ' Configure existing DSN
DeleteUserDSN& = 3 'Delete data source
'ODBC Version 2.5 & higher
CreateSystemDSN& = 4 'Add system data source
ModifySystemDSN& = 5 'Modify an existing system data source
DeleteSystemDSN& = 6 'Remove an existing system data source
'ODBC Version 3.0
'DeleteDefaultDSN& = 7 ' Remove the default data source. Experienced users only!
End Enum
Private Declare Function SQLConfigDataSource Lib "odbccp32.dll" (ByVal hwndParent As Long, ByVal fRequest As Integer, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long
Private Declare Function SQLWriteFileDSN Lib "odbccp32.dll" _
(ByVal lpszFileName As String, ByVal lpszAppName As String, _
ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Public gblUser As String
Public gblPassword As String
Public Function CreateCliDSN(dDSNType As DSNType, DSNName As String, ServerName As String, _
ServerDSN As String, TransportHint As String, _
Optional TCPPort As String, Optional ArrayFetchOn As Integer, _
Optional ArrayBufferSize As Integer, _
Optional UID As String, Optional PWD As String) As Boolean
On Error GoTo errHandler
Dim strDriver As String
Dim lRetVal As Long
Dim sAttrib As String
If (dDSNType < CreateUserDSN) Or (dDSNType > DeleteSystemDSN) Then
CreateCliDSN = False
Exit Function
End If
sAttrib = "DSN=" & DSNName & vbNullChar
If TCPPort = "" Then
sAttrib = sAttrib & "ServerName=" & ServerName & vbNullChar
sAttrib = sAttrib & "TCPPort=1583" & vbNullChar
Else
sAttrib = sAttrib & "ServerName=" & ServerName & "." & TCPPort & vbNullChar
End If
sAttrib = sAttrib & "ServerDSN=" & ServerDSN & vbNullChar
sAttrib = sAttrib & "TransportHint=" & TransportHint & vbNullChar
If ArrayFetchOn > 0 Then
sAttrib = sAttrib & "ArrayFetchOn=" & ArrayFecthOn & vbNullChar
sAttrib = sAttrib & "ArrayBufferSize=" & ArrayBufferSize & vbNullChar
Else
sAttrib = sAttrib & "ArrayFetchOn=0" & vbNullChar
sAttrib = sAttrib & "ArrayBufferSize=0" & vbNullChar
End If
'If UID <> "" Then
sAttrib = sAttrib & "uid=" & UID & vbNullChar
sAttrib = sAttrib & "pwd=" & PWD & vbNullChar
'End If
sAttrib = sAttrib & "AutoDoubleQuote=0" & vbNullChar
sAttrib = sAttrib & "Description=Pervasive ODBC Client Interface" & vbNullChar
sAttrib = sAttrib & "TranslationDLL=" & vbNullChar
sAttrib = sAttrib & "TranslationOption=" & vbNullChar
strDriver = "Pervasive ODBC Client Interface"
lRetVal = SQLConfigDataSource(0&, dDSNType, strDriver, sAttrib)
If lRetVal Then
CreateCliDSN = True 'Execute ok
Else
CreateCliDSN = False
MsgBox "Error: " & vbCrLf & "Invalid attributes" & vbCrLf & "lRetVal= " & lRetVal
End If
Exit Function
errHandler:
MsgBox "Error: " & Err.Number & vbCrLf & _
"Source: " & Err.Source & vbCrLf & _
"Description: " & Err.Description
CreateCliDSN = False
End Function
Public Function CreateEngDSN(dDSNType As DSNType, DSNName As String, Description As String, _
DBN As String, OpenMode As Integer) As Boolean
'CreateEngDSN(DSNTyp, txtEngDSN.Text, txtEngDesc.Text, txtEngDBN.Text, iOpenMode)
On Error GoTo errHandler
Dim strDriver As String
Dim lRetVal As Long
Dim sAttrib As String
If (dDSNType < CreateUserDSN) Or (dDSNType > DeleteSystemDSN) Then
CreateEngDSN = False
Exit Function
End If
sAttrib = "DSN=" & DSNName & vbNullChar
sAttrib = sAttrib & "Description=" & Description & vbNullChar
sAttrib = sAttrib & "DBQ=" & DBN & vbNullChar
sAttrib = sAttrib & "OpenMode=" & OpenMode & vbNullChar
strDriver = "Pervasive ODBC Engine Interface"
lRetVal = SQLConfigDataSource(0&, dDSNType, strDriver, sAttrib)
If lRetVal Then
CreateEngDSN = True 'Execute ok
Else
CreateEngDSN = False
MsgBox "Error: " & vbCrLf & "Invalid attributes" & vbCrLf & "lRetVal= " & lRetVal
End If
Exit Function
errHandler:
MsgBox "Error: " & Err.Number & vbCrLf & _
"Source: " & Err.Source & vbCrLf & _
"Description: " & Err.Description
CreateEngDSN = False
End Function
These
can obviously be modified slightly to meet your needs. Below is my modification of the Create client DSN function.
Private Function Create_ClientDSN(pDSNName As String, pServerName As String, pServerDSN As String) As Boolean
'// Create the client DSN pointing to the server database.
Dim l_strDriver As String
Dim l_lngRetVal As Long
Dim l_strAttributes As String
On Error GoTo ERR_CreateClientDSN
l_strDriver = "Pervasive ODBC Client Interface"
l_strAttributes = "DSN=" & pDSNName & vbNullChar
l_strAttributes = l_strAttributes & "ServerName=" & pServerName & vbNullChar
l_strAttributes = l_strAttributes & "TCPPort=1583" & vbNullChar
l_strAttributes = l_strAttributes & "ServerDSN=" & pServerDSN & vbNullChar
l_strAttributes = l_strAttributes & "TransportHint=TCP:SPX" & vbNullChar
l_strAttributes = l_strAttributes & "ArrayFetchOn=0" & vbNullChar
l_strAttributes = l_strAttributes & "ArrayBufferSize=0" & vbNullChar
l_strAttributes = l_strAttributes & "uid=" & vbNullChar
l_strAttributes = l_strAttributes & "pwd=" & vbNullChar
l_strAttributes = l_strAttributes & "AutoDoubleQuote=0" & vbNullChar
l_strAttributes = l_strAttributes & "Description=Quote Manager ODBC link to " & pServerDSN & vbNullChar
l_strAttributes = l_strAttributes & "TranslationDLL=" & vbNullChar
l_strAttributes = l_strAttributes & "TranslationOption=" & vbNullChar
l_lngRetVal = SQLConfigDataSource(0&, CreateSystemDSN&, l_strDriver, l_strAttributes)
If l_lngRetVal Then
Create_ClientDSN = True '// Successful.
Else
Create_ClientDSN = False '// Falied.
End If
Exit Function
ERR_CreateClientDSN:
Create_ClientDSN = False
End Function
Thanks and Good Luck!
zemp
