vba - Ms access 合并多重访问文件表

Question

我有 60 个具有相同数据库结构的 MS Access 文件。我想从与每个数据库相关的两个表中获取数据，以创建一个包含这 60 个文件中的所有记录的单个数据库。有没有简单的方法来合并所有这些 MS Access 文件？

Answer 1

如果我对您的理解正确，您在 60 个数据库文件中拥有相同的表，并且您正在寻找一种自动聚合它们的方法。

有几种不同的方法可以做到这一点。这可能取决于您的情况。我已经展示了两种不同的方法。

第一种方法很简单。它只是构建一个静态查询，将数据库名称替换为每个查询。如果您的细节过于简单 - 那么这应该可以解决问题。

第二种方法使用DAO打开每个数据库中的每个表，并将数据写入当前数据库。如果您有一次性异常并且需要添加一些智能，则此方法很有用。

Public Sub SimpleCombine()

    Dim DBFileList As Collection
    Dim DBPath As String
    Dim ForeignTableName As String
    Dim LocalTableName As String
    Dim dbfile As Variant

    ' Configure
    Set DBFileList = New Collection
    DBFileList.Add "Test1.accdb"
    DBFileList.Add "Test2.accdb"
    DBPath = CurrentProject.Path ' (No Trailing Backslash)
    ForeignTableName = "Fruit"
    LocalTableName = "Fruit"

    For Each dbfile In DBFileList
      querystr = "INSERT INTO Fruit (FruitName, FruitValue) " & _
                 "SELECT FruitName, FruitValue " & _
                 "FROM Fruit IN '" & DBPath & "\" & dbfile & "'"
      Debug.Print "Transferring Data From " & dbfile
      CurrentDb.Execute querystr
      DoEvents
    Next
End Sub

示例 #2

Public Sub DAOCombine()

  Dim DBFileList As Collection
  Dim DBPath As String
  Dim ForeignTableName As String
  Dim LocalTableName As String
  Dim db As DAO.Database
  Dim rst, drst As DAO.Recordset
  Dim fld As DAO.Field

  ' Configure
  Set DBFileList = New Collection
  DBFileList.Add "Test1.accdb"
  DBFileList.Add "Test2.accdb"
  DBPath = CurrentProject.Path ' (No Trailing Backslash)
  ForeignTableName = "Fruit"
  LocalTableName = "Fruit"

  Set drst = CurrentDb.OpenRecordset(LocalTableName)
  For Each dbfile In DBFileList
    Debug.Print "Transferring Data From " & dbfile
    Set db = DBEngine.Workspaces(0).OpenDatabase(DBPath & "\" & dbfile)
    Set rst = db.OpenRecordset(ForeignTableName)

    Do Until rst.EOF
      drst.AddNew
      For Each fld In rst.Fields
        If (fld.Attributes And dbAutoIncrField) = dbAutoIncrField Then
          ' We have an autonumber field - lets skip
        Else
          drst.Fields(fld.Name).Value = fld.Value
        End If
      Next
      drst.Update
      rst.MoveNext
    Loop
    rst.Close
    DoEvents
  Next
  drst.Close

  Set rst = Nothing
  Set drst = Nothing
End Sub

您需要根据您的特定情况定制代码 - 但它应该可以解决问题。