Question

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

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

更新是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个DDL语句，这些语句引用 tempCorrection ---我不明白为什么那些不会抛出关于找不到表的错误。也许这与DoCmd.RunSQL（和/或你有SetWarnings False）有关。我会将DoCmd.RunSQL替换为db_fe.Execute加dbFailOnError。

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

Answer 2

Per @ 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语句，它仍然会出错。错误序列如下：

我运行一次并在Set tbl = db_fe.TableDefs("tempCorrection")
如果我保留tempCorrection，当我再次运行它时，它可以正常工作。如果我删除tempCorrection并再次运行它，它会给出相同的“找不到项目”错误。

无法从Excel VBA调用更新查询

2 个答案: