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

	Dim wshShell
	
	Set wshShell = CreateObject("WScript.Shell")	
	wshShell.RegWrite "HKLM\SOFTWARE\ODBC\ODBC.INI\MyDSN_Name\Driver", _
		wshShell.ExpandEnvironmentStrings("%SystemRoot%") & "\System32\SQLSRV32.dll"
	wshShell.RegWrite "HKLM\SOFTWARE\ODBC\ODBC.INI\MyDSN_Name\Database", "DatabaseName"
	wshShell.RegWrite "HKLM\SOFTWARE\ODBC\ODBC.INI\MyDSN_Name\Description", "Проверка DSN"
	wshShell.RegWrite "HKLM\SOFTWARE\ODBC\ODBC.INI\MyDSN_Name\Server", "ServerName"
	wshShell.RegWrite "HKLM\SOFTWARE\ODBC\ODBC.INI\MyDSN_Name\Trusted_Connection", "Yes"
	wshShell.RegWrite "HKLM\SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources\MyDSN_Name","SQL Server"