Ms访问Merge Multiple Access文件表

时间:2013-10-21 10:34:33

标签: vba ms-access

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

1 个答案:

答案 0 :(得分:3)

如果我理解正确的话,你会在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

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