1

我对 Access 数据库的经验很少,但是我在 excel 中编写了一个类似的 VBA 宏。我正在尝试将一个 .mdb 文件中的行复制到另一个 .mdb 文件上的完全相同的表中。但是,我希望它仅在它不存在时才导入。有人可以告诉我解决这个问题的最佳方法,也许还有一些我可以使用和修改的代码?我已经查看了堆栈溢出,似乎找不到任何有效的示例。

有 8 个不同的表,在这几百行中。可能有 5-20 列。

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

感谢您的任何帮助或建议,西蒙

编辑 -

Zev 的回答似乎可以完成这项工作,但是我遇到了这个错误,site2 中的 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 列

4

2 回答 2

3

这是一个帮助您入门的示例。它将当前数据库的[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
于 2013-07-16T09:16:30.297 回答
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
于 2013-07-16T12:03:49.483 回答