將行復制到新數據庫中的同一個表中

Question

我對Access數據庫的使用經驗很少，但是我在Excel中編寫了類似的VBA宏。我試圖將一個.mdb文件中的行復制到另一個.mdb文件中的完全相同的表中。不過，如果它不存在，我希望它只導入它。有人能告訴我最好的方式去做這件事，也許我可以使用和修改一些代碼？我已經看過周圍的堆棧溢出，似乎無法找到任何可用的示例。

有8個不同的表格，裏面有幾百行。也許5-20列。

如果腳本可以在VBS內部創建，這將是理想的，因爲它可以讓我在不加載訪問的情況下運行更新。

感謝任何幫助或建議， 西蒙

編輯 -

澤夫的答案似乎做的工作不過我得到這個錯誤，也在裏面站點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 

編輯更多信息：

\站點1 \ ActinicCatalog.mdb - 是目標數據庫 \站點2 \ 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語句。從VBScript使用DAO/ACE：

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