无法从 Excel VBA 调用更新查询

Question

我在 Access 2007 数据库中存储了一个查询。我在这台机器上安装了 Access 2010。我正在尝试执行以下操作：

1. 将 Excel 电子表格导出为数据库中的临时表。
2. 在临时表中添加一列并用文件名填充它
3. 使用导出表的内容更新链接表。

更新是 Access 前端中存储的查询。当我从 Access 运行更新查询时，它工作正常。但是当我使用代码从 VBA 运行它时：

sub test()

filename=thisworkbook.name
Set db_fe = OpenDatabase("C:\Data\myDB.mdb")
If TableExists(db_fe, "tempCorrection") Then
    DoCmd.RunSQL "drop table tempCorrection;"
End If
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "tempCorrection", "C:\Data\corrections.xls", True


DoCmd.RunSQL "alter table tempCorrection add column newColumn text;"
DoCmd.RunSQL "update tempCorrection set newColumn='" & filename & "';", dbFailOnError
db_fe.Execute "updateCorrections", dbFailOnError
DoCmd.RunSQL "drop table tempCorrection;"

end sub

然后在“db_fe.execute”行上出现运行时错误“3078”：“Microsoft Access 数据库引擎找不到输入表或查询“tempCorrection”。确保它存在并且其名称拼写正确。”

查询 updateCorrections 如下所示：

UPDATE production AS p
INNER JOIN tempCorrection AS t
ON
(p.filename=t.filename)
AND
(p.a1=t.a1)
AND
(p.a2=t.a2)
set p.a3=t.a3

关于为什么我无法从 VBA 执行此查询有什么想法吗？

Answer 1

如果您的代码在 Access 会话中正确运行，请考虑从您的 Excel 代码创建一个 Access 应用程序实例，然后从该 Access 应用程序实例运行其余部分。

Const cstrDbPath As String = "C:\Data\myDB.mdb"
Dim appAccess As Object
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase cstrDbPath, False
'then your code ... for example ... '
appAccess.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, _
    "tempCorrection", "C:\Data\conrrections.xls", True
'before you exit the procedure ...'
appAccess.Quit
Set appAccess = Nothing

我希望这能为您指出一些有用的东西。但是，我怀疑这里涉及更多。我鼓励您在模块的声明会话中包含Option Explicit，然后从 VBE 主菜单调试->编译您的应用程序代码。似乎编译器可能会抱怨db_fe，因为您没有将其调暗……它是在其他地方声明的全局变量吗？不管是什么，请务必使用Option Explicit！

编辑：在 TransferSpreadsheet 行上设置一个断点，然后逐行执行其余过程 (F8)。就在您到达db_fe.Execute 行之前，尝试这样的操作以查看是否找到了 tempCorrection：

Debug.Print DCount("*", "tempCorrection")

也不确定这会有多大用处……在这一点上，我基本上是在抓住稻草。我的直觉表明这可能与每次删除然后重新创建 tempCorrection 有关......我会围绕它编写代码。

Edit2：这部分代码让我感到困惑：

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, _
    "tempCorrection", "C:\Data\corrections.xls", True
DoCmd.RunSQL "alter table tempCorrection add column newColumn text;"
DoCmd.RunSQL "update tempCorrection set newColumn='" & _
    filename & "';", dbFailOnError
db_fe.Execute "updateCorrections", dbFailOnError

您使用TransferSpreadsheet 创建表tempCorrection。稍后您在db_fe.Execute 上收到一个错误，表明数据库引擎找不到tempCorrection。但是在这两者之间，您执行了 2 个引用 tempCorrection 的 DDL 语句——我不明白为什么那些不会抛出关于找不到表的错误。也许这与 DoCmd.RunSQL （和/或您的 SetWarnings False）有关。我会将DoCmd.RunSQL 替换为db_fe.Execute 加上dbFailOnError。

同样DoCmd.RunSQL的第二个参数是告诉数据库引擎在执行SQL时是否使用事务。使用dbFailOnError 作为DoCmd.RunSQL 的第二个参数似乎是错误的。

Answer 2

根据@David-W-Fenton 的建议，我将在此处发布update() 的修改代码。我还包含了writeSheetTable() 的代码，该子过程从 Excel 中读取工作表值并将它们写入临时表 tempCorrection。我使用这个 sub 而不是 doCmd.transferspreadsheet 因为我认为在同一过程中使用 doCmd 和 database.execute 可能存在问题。

Sub update()

Dim db_fe As Database
Dim rs As Recordset
Dim tbl As TableDef
Dim fld As DAO.field
Dim tablestruct As String
dim filename as string


'open database'
Set db_fe = OpenDatabase("C:\Data\myDB.mdb")

'define SQL for creating temp table'
tablestruct = "create table tempCorrection " & _
"(a1 text,a2 text,a3 text,a4 text,a5 text,a6 text,a7 text," & _
"a8 text,a9 text,a10 text,a11 text,a12 text,a13 text,a14 text);"

'generate temp table from spreadsheet data'
writeSheetTable "my excel data", db_fe, "tempCorrection", tablestruct


'add field for userID and populate it, normally this is taken from filename'
Set tbl = db_fe.TableDefs("tempCorrection")
Set fld = tbl.CreateField("filename", dbText, 30)
tbl.Fields.Append fld
filename="TEST"
db_fe.Execute "update tempCorrection set filename='" & filename & "';", dbFailOnError
Debug.Print DCount("*", "tempCorrection")

'execute stored query updateCorrections, which I provided in my original question'
db_fe.Execute "updateCorrections"

'delete temp table'
db_fe.Execute "drop table tempCorrection;"

End Sub


Sub writeSheetTable(sheetname As String, db As Database, tablename As String, tablestruct As String)

Dim lastrow, lastcol, max As Long
Dim prodarray As Variant
Dim rs As Recordset
Dim ws As DAO.Workspace
Dim r, c As Long

'read in the sheet contents to prodArray'
With Sheets(sheetname)
    lastrow = .UsedRange.Rows.Count
    lastcol = .UsedRange.Columns.Count
    prodarray = .Range(.Cells(2, 1), .Cells(lastrow, lastcol))
End With
max = UBound(prodarray, 1)


'drop temp table if it already exists'
If TableExists(db, tablename) Then
    db.Execute "drop table " & tablename & ";"
End If


'create table using SQL defined in update()'
db.Execute tablestruct, dbFailOnError


'build table row by row as a recordset, using transaction to speed up appends'
Set rs = db.OpenRecordset(tablename)
Set ws = DBEngine.Workspaces(0)
ws.BeginTrans    
With rs
For r = 1 To UBound(prodarray, 1)
    .AddNew
    For c = 1 To UBound(prodarray, 2)
        .Fields(c - 1) = IIf(prodarray(r, c) = Empty, "", prodarray(r, c))
    Next
    .update
Next
End With
ws.CommitTrans

'destroy recordset object'
rs.Close
Set rs = Nothing

End Sub

即使我已将所有 DoCmd.RunSQl 语句替换为 database.execute，它仍然会出现错误。错误顺序如下：

1. 我运行它一次并在Set tbl = db_fe.TableDefs("tempCorrection") 上收到“未在此集合中找到项目”错误
2. 如果我保留 tempCorrection 存在，当我再次运行它时，它工作正常。如果我删除 tempCorrection 并再次运行它，它会给出相同的“未找到项目”错误。