Private Const ODBC_ADD_DSN = 1
Private Const ODBC_CONFIG_DSN = 2
Private Const ODBC_REMOVE_DSN = 3
Private Const ODBC_ADD_SYS_DSN = 4
Private Const ODBC_REMOVE_SYS_DSN = 6
Private Const vbAPINull As Long = 0&
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 Sub CreateDSN(sDSN As String)
On Error Resume Next
Dim nRet As Long
Dim sDriver As String
Dim sAttributes As String
sDriver = "SQl server"
sAttributes = "DSN=" & sDSN & Chr$(0)
sAttributes = sAttributes & "Server=(local)" & Chr$(0)
sAttributes = sAttributes & "Database=webstation" & Chr$(0)
nRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_SYS_DSN, sDriver, sAttributes)
End Sub
Public Sub DeleteDSN(sDSN As String)
On Error Resume Next
Dim nRet As Long
Dim sDriver As String
Dim sAttributes As String
sDriver = "SQl server"
sAttributes = sAttributes & "DSN=" & sDSN & Chr$(0)
nRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_SYS_DSN, sDriver, sAttributes)
End Sub

解决方案 »

  1.   

    http://www.csdn.net/Expert/TopicView1.asp?id=777670
      

  2.   

    ’用ODBC API函数SQLConfigDataSource'声明
    Private Const ODBC_ADD_DSN = 1 ' Add user data source
    Private Const ODBC_CONFIG_DSN = 2 ' Configure (edit) user data source
    Private Const ODBC_REMOVE_DSN = 3 ' Remove user data source
    Private Const ODBC_ADD_SYS_DSN = 4 'Add sys data source
    Private Const ODBC_REMOVE_SYS_DSN = 6 'Remove sys data source
    Private Const vbAPINull As Long = 0& ' NULL Pointer
    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'ACCESS数据库    strDriver = "Microsoft Access Driver (*.mdb)"
        strAttributes = ""
        strAttributes = strAttributes & "DSN=MGCP" & Chr$(0)
        strAttributes = strAttributes & "FIL=MS Access" & Chr$(0)
        strAttributes = strAttributes & "DESCRIPTION=TempDSN" & Chr$(0)
        strAttributes = strAttributes & "DBQ=" & SetupWebDir & "\Adm\MSU\msu\msu_config.mdb" & Chr$(0)
        strAttributes = strAttributes & "DefaultDir=" & SetupWebDir & "\Adm\MSU\msu\" & Chr$(0) & Chr$(0)
        '如果要显示对话,可使用 Form1.Hwnd 代替 vbAPINull.
        intRet = SQLConfigDataSource(vbAPINull, 4, strDriver, strAttributes)
        If intRet Then
        Else
            MsgBox "建立系统ODBC数据源出错,请确认安装了ODBC For Access驱动程序!", vbOKOnly + vbExclamation, titODBCError
        End If
    '以下为SQL SERVER的ODBC数据源,注意UID和PWD不能写,否则会出错
        strAttributes = ""
        strAttributes = strAttributes & "DSN=MGCP" & Chr$(0)
        'strAttributes = strAttributes & "UID=sa" & Chr$(0)
        'strAttributes = strAttributes & "PWD=123" & Chr$(0)
        strAttributes = strAttributes & "SERVER=" & DBServer & Chr$(0)
        strAttributes = strAttributes & "DESCRIPTION=MGCP DSN" & Chr$(0)
        strAttributes = strAttributes & "DATABASE=msu_config" & Chr$(0) & Chr$(0)
        '如果要显示对话,可使用 Form1.Hwnd 代替 vbAPINull.
        intRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_SYS_DSN, strDriver, strAttributes)
        If intRet Then
        Else
             MsgBox msgODBCError, vbOKOnly + vbExclamation, titODBCError
        End If