Option Explicit

' Declare SQLConfigDataSource Constants.

Const ODBC_ADD_DSN =  1           ' Add File DSN
Const ODBC_CONFIG_DSN =  2        ' Configure (edit) File DSN
Const ODBC_REMOVE_DSN =  3        ' Remove File DSN
Const ODBC_ADD_SYS_DSN =  4       ' Add System DSN
Const ODBC_CONFIG_SYS_DSN =  5    ' Configure (edit) System DSN
Const ODBC_REMOVE_SYS_DSN =  6    ' Remove System DSN
Const vbAPINull As Long =  0 &    ' NULL Pointer

Const DEFAULT_SERVERNAME = "MyServer"
Const DEFAULT_DATABASENAME = "MyDatabase"
Const DEFAULT_SQL_DRIVER = "SQL Server"

Public Enum DSNTypeConstants
    SystemDSN = ODBC_ADD_SYS_DSN
    UserDSN = ODBC_ADD_DSN
End Enum

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

'============================================================

Public Function RegisterDSN(ByVal DataSourceName As String, _
    Optional ByVal DSNType As DSNTypeConstants = SystemDSN, _
    Optional ByVal TrustedConnection As Integer =  1 ) As Boolean

    Dim strAttributes As String
    Dim lngReturnCode As Long

    On Error GoTo RegisterDSN_Error

    strAttributes = "SERVER=" & DEFAULT_SERVERNAME & Chr$( 0 )
    strAttributes = strAttributes & "DESCRIPTION=" & DataSourceName & " DataSource " & Chr$( 0 )
    strAttributes = strAttributes & "DSN=" & DataSourceName & Chr$( 0 )
    strAttributes = strAttributes & "DATABASE=" & DEFAULT_DATABASENAME & Chr$( 0 )

    '   Setting the TrustedConnection value to '0' does not work!!
    '   Just exclude the attribute!!

    If TrustedConnection =  1  Then
        strAttributes = strAttributes & "TRUSTED_CONNECTION=" & TrustedConnection & Chr$( 0 )
    End If


    If SQLConfigDataSource(vbAPINull, DSNType, _
            DEFAULT_SQL_DRIVER, strAttributes) Then RegisterDSN = True

Quit_RegisterDSN:
        Exit Function

RegisterDSN_Error:
        Beep
        MsgBox Err.Description, vbCritical, "Error Registering " & DataSourceName & " Data Source"
        Resume Quit_RegisterDSN

End Function


Private Sub Command1_Click()
    RegisterDSN "Test"
End Sub