自动配置ODBC数据源的代码问题

Question

看到书上有一段代码，是自动配置ODBC数据源的，可是，我改造了以下，在用于配置ACCESS数据库，就出现了问题，代码如下：
Private Const ODBC_ADD_DSN = 1
Private Const ODBC_CONFIG_DSN = 2
Private Const ODBC_REMOVE_DSN = 3
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 LongPublic Sub CreateDSN(sDSN As String)
Dim nRet As Long
Dim sDriver As String
Dim sAttribute As String
'驱动这么写对吗？
sDriver = "MicroSoft Access Driver 4.00.3711.08"
sAttributes = "Server=Microsoft Access" & Chr$(0)
sAttributes = sAttributes & " Description= " & sDSN & Chr$(0)
sAttributes = sAttributes & "DSN=" & sDSN & Chr$(0)
’DATABASE可以设置路径吗？
sAttributes = sAttributes & "DATABASE=c:\信息管理系统\info_DB.mdb" & Chr$(0)
sAttributes = sAttributes & "UID=admin" & Chr$(0)
sAttributes = sAttributes & "PWD= " & Chr$(0)
’在此处出现问题：ODBC调用失败
DBEngine.RegisterDatabase sDSN, sDriver, True, sAttributes
nRet = SQLCONFIGDataSource(vbapinull, ODBC_ADD_DSN, sDriver, sAttributes)
End SubPublic Sub DeleteDSN(sDSN As String)
Dim nRet As Long
Dim sDriver As String
Dim sAttributes As String
sDriver = "Microsoft Access Driver"
sAttributes = sAttributes & "DSN=" & sDSN & Chr$(0)
nRet = SQLCONFIGDataSource(vbapinull, ODBC_REMOVE_DSN, sDriver, sAttributes)
End SubPrivate Sub Command1_Click()
CreateDSN "libraries"End SubPrivate Sub Command2_Click()
DeleteDSN "libraries"End Sub请各位大虾帮忙，不胜感激；能将上述代码详细介绍以下就更好了。

Answer 1

我试了一下，出现如你所书问题。我估计是sAttributes
写的有问题。关注！

Answer 2

下面是我改进的自动配置access数据源程序，在我的程序中是这样用的.Option ExplicitPrivate Declare Function SQLConfigDataSource Lib "odbccp32.dll" ( _
    ByVal hwndParent As Long, _
    ByVal fRequest As Integer, _
    ByVal lpszDriver As String, _
    ByVal lpszAttributes As String) As LongPrivate Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
    ByVal hkey As Long, _
    ByVal lpsubkey As String, _
    ByVal Reserved As Long, _
    ByVal samDesired As Long, _
    phkResult As Long) As Long
    
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" ( _
    ByVal hkey As Long, _
    ByVal lpvaluename As String, _
    ByVal lpReserved As Long, _
    ByRef lpType As Long, _
    ByVal lpData As String, _
    ByRef lpcbData As Long) As Long
    
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hkey As Long) As LongPrivate Const REG_BINARY& = 3                 ' Free form binary
Private Const REG_SZ& = 1                     ' Unicode null terminated string
Private Const HKEY_CURRENT_USER& = &H80000001
Private Const HKEY_LOCAL_MACHINE& = &H80000002
Private Const KEY_ALL_ACCESS& = &H2003F'系统DSN特性仅在 ODBC 2.5以上环境下有效
Private Enum ACTION
    ODBC_ADD_DSN& = 1            ' 添加一个用户数据源(DSN)
    ODBC_CONFIGURE_DSN& = 2      ' 配置已存在的用户数据源DSN
    ODBC_REMOVE_DSN& = 3         ' 删除一个指定的数据源
    ODBC_ADD_SYS_DSN& = 4        ' 添加一个系统数据源(DSN)
    ODBC_CONFIG_SYS_DSN& = 5     ' 修改一个已存在的系统数据源(DSN)
    ODBC_REMOVE_SYS_DSN = 6      ' 删除指定的已存在的系统数据源（DSN）
    ODBC_REMOVE_DEFAULT_DSN& = 7 ' 删除缺省的数据源
End Enum
Public Sub AddSystemDSN(ByVal sDSN As String, _
    ByVal sDriver As String, _
    ByVal sDBFile As String _
    )
    
    Dim sAttributes   As String
    Dim sDBQ          As String
    Dim sRegValue     As String
    Dim lRetVal       As Long
    Dim hkey          As Long
    Dim lValueType    As Long
    Dim eaction       As ACTION
    
    If RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
        "Software\ODBC\ODBC.INI\" & sDSN, _
        0, _
        KEY_ALL_ACCESS, hkey _
        ) = 0 Then
        
        sRegValue = String(1024, 0)        If RegQueryValueEx(hkey, _
            "DBQ", _
            0, _
            lValueType, _
            sRegValue, _
            Len(sRegValue) _
            ) = 0 Then            If lValueType = REG_SZ Then
                sDBQ = Left(sRegValue, InStr(sRegValue, vbNullChar) - 1)
            End If
            
            '如果已存在该数据源，则修改。
            If sDBQ <> sDBFile Then
                eaction = ODBC_CONFIG_SYS_DSN
                sAttributes = "DSN=" & sDSN & vbNullChar & "DBQ=" & sDBFile & vbNullChar
                lRetVal = SQLConfigDataSource(0&, eaction, sDriver, sAttributes)
            End If        Else
            '非Access数据源，先删除后创建
            eaction = ODBC_ADD_SYS_DSN
            sAttributes = "DSN=" & sDSN & vbNullChar & "DBQ=" & sDBFile & vbNullChar
            lRetVal = SQLConfigDataSource(0&, eaction, sDriver, sAttributes)
        End If
        
        RegCloseKey hkey
        
    Else
    
        '创建数据源
        eaction = ODBC_ADD_SYS_DSN
        sAttributes = "DSN=" & sDSN & vbNullChar & "DBQ=" & sDBFile & vbNullChar
        lRetVal = SQLConfigDataSource(0&, eaction, sDriver, sAttributes)    End If
    
End Sub
Private Sub Form_Load()
Dim route As String
   
    route = App.Path & "\database\管理系统.mdb"
    
    If Dir(route) = "" Then
        MsgBox "数据库不存在!", vbCritical, "错误"
        End
    End If    AddSystemDSN "DataSourceName", "Microsoft Access Driver (*.mdb)", route
    
End Sub你只要把 数据源名 和 数据库名 换成自己的就行了。