将数据从一个 MS Access 数据库复制到另一个

Question

我有两个 MS Access 数据库，一个包含大量数据，另一个几乎是空的。我需要将所有数据从第一个数据库迁移到第二个数据库。它们具有相同的表名和几乎相同的列名，但第二个数据库具有更多列。

因此，如果列具有相同的名称，我想将数据从数据库一复制到数据库二。

这是因为我更新了计费软件，数据库不完全兼容。

我只尝试手动复制/粘贴数据，但每个数据库上大约有20个表，+20列，这是一项非常繁琐的工作。

Answer 1

问题的编程解决方案

使用 MS Access 和 VBA 制作解决方案，使用 DAO（数据访问对象）和 ADO（ActiveX 数据库对象）进行数据迁移。 此代码已在 MS Access 2016 中成功实现。此代码驻留在第二个数据库中。

实施步骤

1. 创建两个单独的 ADODB.Connection 与数据库
2. 然后从数据库中获取表列表
3. 然后在两个数据库中按列交叉匹配表
4. 如果匹配则将第一个数据库的表中的数据附加到第二个数据库

代码上的注释足以理解程序。

Private Sub AddDataFrom1stDB()
    Dim currDB As String
    currDB = CurrentProject.Path & "\" & CurrentProject.Name '2nd Database'
    Dim ExtConn As New ADODB.Connection, LocConn As New ADODB.Connection, strFind As String
    cmnDLG.DialogTitle = "Open Access DB file"
    cmnDLG.FileName = ""
    cmnDLG.DefaultExt = ".Accdb"
    cmnDLG.Filter = "EXCEL files (*.Accdb)|*.AccDB|All files(*.*)|*.*"
    cmnDLG.ShowOpen
    Dim TargetDB As String
    TargetDB = cmnDLG.FileName 'Get File name of 1st Database'
    ExtConn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source = " & TargetDB & "; Persist Security Info=False;"
    ExtConn.Open '1st Database Connection'
    Set LocConn = CurrentProject.Connection '2nd Database connection'
    
    
    Dim ExtRS As New ADODB.Recordset, LocRS As New ADODB.Recordset
    ExtRS.CursorLocation = adUseClient: LocRS.CursorLocation = adUseClient
    arrCriteria = Array(Empty, Empty, Empty, “Table”)
    Set ExtRS = ExtConn.OpenSchema(adSchemaTables, arrCriteria) 'Get Table List of 1st Database'
    Set LocRS = LocConn.OpenSchema(adSchemaTables, arrCriteria) 'Get Table List of 2nd Database'
    strFind = "Table_Type='TABLE'"
    LocRS.Filter = strFind: ExtRS.Filter = strFind
    If LocRS.RecordCount > 0 Then LocRS.MoveFirst
    Dim LocTbl As String
    
    Dim rsLTbl As New ADODB.Recordset, rsRTbl As New ADODB.Recordset
    Dim rsLFld As New ADODB.Recordset, rsRFld As New ADODB.Recordset
    Dim cno As Integer, switch As Boolean
    
    Do Until LocRS.EOF '*1 comparing table list based on 2nd Databases Table List'
        switch = True
        LocTbl = LocRS.Fields("TABLE_NAME").Value
        lstTables.AddItem (LocTbl)
        strFind = "TABLE_NAME='" & LocTbl & "'"
        If ExtRS.RecordCount > 0 Then ExtRS.MoveFirst
        ExtRS.Find strFind
        If Not ExtRS.EOF Then
            Set rsLFld = ListTableColumns(LocTbl, currDB)   ' Get Column Name and Type from 2nd Database'
            Set rsRFld = ListTableColumns(LocTbl, TargetDB) ' Get Column Name and Type from 1st Database'
            If rsLFld.RecordCount = rsRFld.RecordCount Then ' Comparing number of fields in two table'
                rsLFld.Sort = "Column_Name": rsRFld.Sort = "Column_Name"
                Do Until rsLFld.EOF   ' Checking Column name and Column Type'
                    strFind = "Column_Name='" & rsLFld!Column_Name & "'"
                    rsRFld.MoveFirst
                    rsRFld.Find strFind
                    If Not rsRFld.EOF Then
                        If rsLFld!Column_Type = rsRFld!Column_Type Then
                            
                        Else
                            switch = False
                            Exit Do
                        End If
                        
                    End If
                  rsLFld.MoveNext
                Loop
                If switch = True Then 'Entering data from 1st Database to 2nd Database'
                    If rsLTbl.State = adStateOpen Then rsLTbl.Close
                    rsLTbl.Open "SELECT * FROM " & LocTbl, LocConn, adOpenDynamic, adLockOptimistic
                    If rsRTbl.State = adStateOpen Then rsRTbl.Close
                    rsRTbl.Open "SELECT * FROM " & LocTbl, ExtConn, adOpenStatic, adLockReadOnly
                    Do Until rsRTbl.EOF
                        rsLTbl.AddNew
                        For cno = 0 To rsRTbl.Fields.Count - 1
                            rsLTbl.Fields(rsRTbl.Fields(cno).Name).Value = rsRTbl.Fields(rsRTbl.Fields(cno).Name).Value
                        Next
                        rsLTbl.Update
                        rsRTbl.MoveNext
                    Loop
                End If
            End If
        End If
        LocRS.MoveNext
    Loop '1*'
    MsgBox "Done...", vbInformation
End Sub



Public Function ListTableColumns(sTableName As String, xDB As String) As ADODB.Recordset
    'Creating list of Column name and column type of table'
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim rs As New ADODB.Recordset
    
    Set db = OpenDatabase(xDB)
    Set tdf = db.TableDefs(sTableName)  ' Replace with your table name'

    rs.Fields.Append "Column_Name", adVarChar, 200
    rs.Fields.Append "Column_Type", adVarChar, 100
    rs.Open
    For Each fld In tdf.Fields
        rs.AddNew
        rs!Column_Name = fld.Name: rs!Column_Type = fld.Type
        rs.Update
    Next fld
    
    Set ListTableColumns = rs
End Function