更新Access 2003 MDB以指向不同的SQL Server數據庫

Question

Access 2003/SQL Server - 如何更新Access 2003 MDB（Connect屬性）以指向不同的SQL Server數據庫？新的SQL Server數據庫與舊的數據庫位於同一個實例上。

Answer 1

我有幾個我管理的MS Access 2003/SQL Server應用程序。它們都在啓動時動態附加到正確的數據庫。它們中的一些甚至在啓動序列期間連接到不同服務器上的多個數據庫。它們都使用相同的基本vba例程來實際將表格動態附加到正確的服務器。這不是我的代碼，我是通過在互聯網上搜索來找到它的，但現在我已經失去了它的參考，所以提前向作者道歉。

在顯示代碼之前，爲了將它放在上下文中，我通常使用一個形式爲「frmInitApp」的數據源，該數據源是一個本地配置表，其中一個名爲「ID」的字段。我從AutoExec宏啓動訪問應用程序，該應用程序使用「ID = 1」的過濾器打開此窗體。我有其他形式來操縱這個配置表並改變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