Question

我对Access数据库的经验很少，但我在excel中编写了类似的VBA宏。我试图将一个.mdb文件中的行复制到另一个.mdb文件中的完全相同的表中。但是，如果它还没有存在，我希望它只导入它。有人可以告诉我最好的方法，也许我可以使用和修改一些代码？我已经查看了堆栈溢出，似乎无法找到任何有用的示例。

有8个不同的表，其中有几百行。可能有5-20列。

如果脚本可以在VBS中制作，那么这将是理想的，因为它允许我在不加载访问的情况下运行更新。

感谢您提供任何帮助或建议，西蒙

编辑 -

Zev的答案似乎可以完成这项工作，但是我收到了这个错误，也就是我在复制的网站2中的MDB并将其放入site1

Error: Expected end of statement
Code: 800A0401
Line: 17
Char: 13

代码（保存为“update.vbs”）：

Dim eng
Set eng = CreateObject("DAO.DBEngine.120")
Set dest = eng.OpenDatabase("C:\Users\simon\Documents\garden games redesign\import script\Site1\ActinicCatalog.mdb")

Sub CopyTable()
    Dim rs
    Set rs = dest.OpenRecordset("Person")

    Dim sWhere
    For Each fld In rs.Fields
        sWhere = sWhere & " AND " & fld.Name & " <> t1." & fld.Name
    Next
    sWhere = Mid(sWhere, 6)

    Dim sql: sql= _
        "INSERT INTO Person " & _
        "SELECT * " & _
        "FROM Person AS t1 IN ""C:\Users\simon\Documents\garden games redesign\import script\Site2\ActinicCatalog.mdb"" " & _
        "WHERE " & sWhere
    dest.Execute(sql)
End Sub

编辑以获取更多信息：

\ Site1 \ ActinicCatalog.mdb - 是目标数据库 \ Site2 \ ActinicCatalog.mdb - 是原始数据库

这些数据库有大约20列

Answer 1

这是一个让你入门的例子。它将当前数据库的[Table1]的内容复制到第二个数据库的[Table1]。

Option Compare Database
Option Explicit

Sub copyTables()

    'Open source database
    Dim dSource As Database
    Set dSource = CurrentDb

    'Open dest database
    Dim dDest As Database
    Set dDest = DAO.OpenDatabase("C:\Users\Admin\Desktop\DBdest.accdb")

    'Open source recordset
    Dim rSource As Recordset
    Set rSource = dSource.OpenRecordset("Table1", dbOpenForwardOnly)

    'Open dest recordset
    Dim rDest As Recordset
    Set rDest = dDest.OpenRecordset("Table1", dbOpenDynaset)

    'Loop through source recordset
    While Not rSource.EOF

        'Look for record in dest recordset
        rDest.FindFirst _
            "Field1 = '" & rSource.Fields("Field1") & "' AND " & _
            "Field2 = " & rSource.Fields("Field2")

        'If not found, copy record - Field1 is text / Field2 is numeric
        If rDest.NoMatch Then
            rDest.AddNew
            rDest.Fields("Field1") = rSource.Fields("Field1")
            rDest.Fields("Field2") = rSource.Fields("Field2")
            rDest.Update
        End If

        'Next source record
        rSource.MoveNext
    Wend

    'Close dest recordset
    rDest.Close
    Set rDest = Nothing

    'Close source recordset
    rSource.Close
    Set rSource = Nothing

    'Close dest database
    dDest.Close
    Set dDest = Nothing

    'Close source database
    dSource.Close
    Set dSource = Nothing
End Sub

Answer 2

如果可能，我建议使用SQL语句。从使用DAO / ACE的VBScript：

Dim eng
Set eng = CreateObject("DAO.DBEngine.120")
Set dest = eng.OpenDatabase("path\to\destination\database.accdb")

使用ADO：

Dim conn
Set conn = CreateObject("ADODB.Connection")
With conn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .ConnectionString = "Data Source=""path\to\destination\database.accdb"";"
    .Open
End With

SQL语句将是这样的：

INSERT INTO Table1
SELECT *
FROM Table1 AS t1 IN "path\to\source\database.accdb"
WHERE Table1.Field1 <> t1.Field1

并执行如下：

Dim sql = _
    "INSERT INTO Table1 " & _
    "SELECT * " & _
    "FROM Table1 AS t1 IN "path\to\source\database.accdb" " & _
    "WHERE Table1.Field1 <> t1.Field1"

'Using DAO or ADO
dest.Execute sql

考虑到每个表都有可变数量的列，您可能必须动态生成WHERE表达式：

Sub CopyTable(tablename)
    Dim rs
    Set rs = dest.OpenRecordset(tablename)
    'if using ADO:
    'Set rs = conn.Execute(tablename)

    Dim sWhere
    For Each fld In rs.Fields
        sWhere = sWhere & " AND " & fld.Name & " <> t1." & fld.Name
    Next
    sWhere = Mid(sWhere, 6)

    Dim sql
    sql = _
        "INSERT INTO " & tablename & " " & _
        "SELECT * " & _
        "FROM " & tablename & " AS t1 IN ""path\to\source\database.accdb"" " & _
        "WHERE " & sWhere
    dest.Execute(sql)
End Sub

<强>更新
如果您只使用一列来确定记录是否存在，那么SQL语句应如下所示：

INSERT INTO Table1
SELECT *
FROM Table1 AS t1 IN "path\to\source\database.accdb"
LEFT JOIN Table1 ON t1.FirstField = Table1.FirstField
WHERE Table1.FirstField IS NULL

和CopyTable是这样的：

Sub CopyTable(tablename)
    Dim rs
    Set rs = dest.OpenRecordset(tablename)
    'if using ADO:
    'Set rs = conn.Execute(tablename)

    Dim field0Name
    field0Name=rs.Fields(0).Name

    Dim sql
    sql = _
        "INSERT INTO " & tablename & " " & _
        "SELECT * " & _
        "FROM " & tablename & " AS t1 IN ""path\to\source\database.accdb"" " & _
        "LEFT JOIN " & tablename & " ON t1." & field0Name & "=" & tablename & "." & field0Name & " " & _
        "WHERE " & tablename & "." & field0Name & " IS NULL"
    dest.Execute(sql)
End Sub

将Row复制到新数据库中的同一个表

2 个答案: