Question

Access 2003 / SQL Server - 如何更新Access 2003 MDB（Connect属性）以指向其他SQL Server数据库？新的SQL Server数据库与旧的SQL Server数据库位于同一个实例上。

Answer 1

我有几个我管理的MS Access 2003 / SQL Server应用程序。所有这些都在启动时动态连接到正确的数据库。其中一些甚至在启动序列期间连接到不同服务器上的多个数据库。所有这些都使用相同的基本vba例程来实际动态地将表附加到正确的服务器。这不是我的代码，我通过网络搜索找到它，但我现在已经失去了对它的引用，所以请提前向作者道歉。

在显示代码之前，要将它放在上下文中，我通常会有一个表单＆＃34; frmInitApp＆＃34;使用数据源作为本地配置表，其中包含名为＆＃34; ID＆＃34;的字段。我从AutoExec宏启动访问应用程序，该宏打开此表单并使用＆＃34; ID = 1＆＃34;的过滤器。我有其他形式来操作这个配置表并更改ID，所以要在生产和测试之间切换，我只需更改ID为1的条目。

我还有另一个本地表tableList，其中包含我想要动态连接到SQL Server的Access表列表。对于SQL Server表名，大多数应用程序在此表中都有另一个字段（因此它们不必相同） - 某些应用程序有一个额外的字段来指定哪个数据库。但是你需要的其他意大利面越复杂 - 我经常最终得到另一个连接字符串表到我可能连接到的所有单独的数据库等等。为了保持简单，只需在配置表中的字段中连接字符串即可是frmInitApp的数据源。

我们开始使用frmInitApp上的当前事件。

    Private Sub Form_Current()
        If Me.Filter = "" Then 'If nobody has told us what record to use then use id=1
            Me.Filter = "[ID]=1"
            configID = 1
        Else
            configID = CInt(Mid(Me.Filter, 6)) 'We are assuming the load criteria are "[ID]=..."
        End If

        Me.messages = "Connecting to databases ..."
        DoCmd.Hourglass True
        Me.stage = "InitialStartup" 'Set the stage which is to be executed during timer phase
        Me.TimerInterval = 100 'We set the time to go off to so we can let autoexec finish and let us control focus
    End Sub

然后在计时器中我们可以通过附加表函数链接到表格，我会更进一步说明问题。另请注意，我们重新链接传递查询，因此它们也指向新数据库。另请注意，一旦我们连接到第一个表，我们就开始打开一个新表单登录一个用户。我没有显示结论，当完成所有操作时，可能必须在附表中验证用户名和密码，但无论如何都要弄清楚它。

Private Sub Form_Timer()
    Dim conn As ADODB.Connection
    Dim dbRs As ADODB.Recordset
    Dim dbOK As Boolean
    Dim SQL As String

    Dim startedLogon As Boolean
    Me.TimerInterval = 0
    Select Case Me.stage
    Case "InitialStartup"
        Set conn = CurrentProject.Connection
        startedLogon = False
        If CurrentProject.AllForms("frmLogon").IsLoaded Then
            'If its already loaded this NOT the first time through, but still need to logon ...
            If Form_frmLogon.configID = configID Then
                startedLogon = True 'unless its the same config
            End If
        End If
        dbOK = True
        Set dbRs = New ADODB.Recordset
        dbRs.Open "SELECT localname,servername FROM tableList", conn
        While dbOK And Not dbRs.EOF
        'PLEASE NOTE - WHILST THEORETICALLY "localname" and "servername" could be different the migration process
        'requires that they be the same.  Do not consider changing this until after migration is completed

            dbOK = AttachTable(dbRs("localname"), "dbo." & dbRs("servername"))
            dbRs.MoveNext
            If Not startedLogon And dbOK Then
                DoCmd.Close acForm, "frmLogon"      '#554 Just in case its alread open - we need to pick up new params
                DoCmd.OpenForm "frmLogon", , , , , , Nz(Me.lastUserId, "") & ":" & configID
                Form_frmLogon.SetFocus              '#748 Give it focus
                startedLogon = True
            End If
        Wend
        dbRs.Close
        If dbOK Then

             Me.messages = "Relinking Common Queries ..."
             DoEvents

             Dim qd As DAO.QueryDef, cs As String

             cs = getStrConnDAO 'get the DAO connection string
             For Each qd In CurrentDb.QueryDefs
                 If Len(qd.Connect & vbNullString) > 0 Then
                     qd.Connect = cs
                 End If
             Next

        End If
        Me.messages = "Awaiting User Log On"
        DoCmd.Hourglass False
        DoEvents
        ... the rest just managing logon
End Sub

附表功能

'//Name     :   AttachTable
    '//Purpose  :   Create a linked table to SQL Server without using a DSN
    '//Parameters
    '//     stLocalTableName: Name of the table that you are creating in the current database
    '//     stRemoteTableName: Name of the table that you are linking to on the SQL Server database
Private Function AttachTable(stLocalTableName As String, stRemoteTableName As String)
    Dim td As TableDef
    Dim stConnect As String
    Me.messages = "Connecting to Database Table " & Me.mainDatabase & "." & stRemoteTableName
    DoEvents
    On Error Resume Next
    CurrentDb.TableDefs.Delete stLocalTableName
    If Err.Number <> 0 Then
        If Err.Number <> 3265 Then GoTo AttachTable_Err 'v4.0.44 - allow delete errors
        Err.Clear
    End If
    On Error GoTo AttachTable_Err
    Set td = CurrentDb.CreateTableDef(stLocalTableName, dbAttachSavePWD, stRemoteTableName, getStrConnDAO(configID))
    CurrentDb.TableDefs.Append td
    DoEvents
    AttachTable = True
    Exit Function

AttachTable_Err:

    AttachTable = False
    errMsg = "AttachTable encountered an unexpected error: " & Err.description & " on table " & stRemoteTableName & " in database " & Me.mainDatabase

End Function

您需要getConStrDAO函数

Private ADOconnStr As String
Private DAOconnStr As String
Public Function getStrConn(Optional configID As Long = 0) As String
    'create a connection string for use when running stored procedures
    'this uses the saved value if possible, but global variables are reset if an error occurs
    If ADOconnStr = "" Then
        Dim conn As ADODB.Connection
        Dim rs As ADODB.Recordset
        Dim account As String
        Dim revealedPassword As String
        Dim s As String, i As Integer, x As String
        Set conn = CurrentProject.Connection
        If configID = 0 Then configID = Nz(Form_frmLogon.configID, 0)
        Set rs = conn.Execute("SELECT *  FROM localConfig WHERE id =" & configID)
        If Not rs.EOF Then
            ADOconnStr = "Provider=Microsoft.Access.OLEDB.10.0;Data Provider=SQLOLEDB;SERVER="  'this provider is needed to allow use of SP as form.recordset
            ADOconnStr = ADOconnStr & rs("ServerName") & ";DATABASE=" & rs("DatabaseName") & ";UID="
            ADOconnStr = ADOconnStr & rs("dbUser") & ";PWD=" & EncryptDecrypt(Nz(rs("dbPassword"), ""))
        End If
        rs.Close
        Set rs = Nothing
        Set conn = Nothing
    End If
    getStrConn = ADOconnStr
End Function
Public Sub resetConnection()
    ADOconnStr = ""
    DAOconnStr = ""
End Sub
Function getStrConnDAO(Optional configID As Long = 0) As String
    If DAOconnStr = "" Then
        Dim a As New ADODB.Connection
        a.Open getStrConn(configID)
        DAOconnStr = "ODBC;driver=SQL Server;" & a.Properties("Extended Properties") & ";"
        Set a = Nothing
    End If
    getStrConnDAO = DAOconnStr
End Function

最后一个简单的数据库密码加密使其对于随意的眼睛来说并不明显 - 再次从互联网上复制了

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments:   Performs XOr encryption/decryption on string data. Passing a
'''             string through the procedure once encrypts it, passing it
'''             through a second time decrypts it.
'''
''' Arguments:  szData          [in|out] A string containing the data to
'''                             encrypt or decrypt.
'''
''' Date        Developer       Action
''' --------------------------------------------------------------------------
''' 05/18/05    Rob Bovey       Created
'''
Public Function EncryptDecrypt(szData As String) As String

    Const lKEY_VALUE As Long = 215

    Dim bytData() As Byte
    Dim lCount As Long

    bytData = szData

    For lCount = LBound(bytData) To UBound(bytData)
        bytData(lCount) = bytData(lCount) Xor lKEY_VALUE
    Next lCount

    EncryptDecrypt = bytData

End Function

将Access 2003 MDB更新为指向其他SQL Server数据库

1 个答案: