невозможно вызвать запрос на обновление из 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, рассмотрите возможность создания экземпляра приложения Access из кода Excel, а затем запустите остальные из этого экземпляра приложения 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, так как вы не Dim его ... это глобальная переменная, объявленная в другом месте?Что бы это ни было, обязательно используйте Option Explicit!

Редактировать : установите точку разрыва в строке TransferSpreadsheet, затем построчно пройдитесь по остальной части процедуры (F8).Непосредственно перед тем, как перейти к строке db_fe.Execute, попробуйте что-то вроде этого, чтобы увидеть, найден ли tempCorrection:

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

Не уверен, насколько это будет полезно, либо ... на данный момент я в основномхватаясь за соломинку.Моя интуиция подсказывает, что это может иметь какое-то отношение к удалению и повторному созданию tempCorrection каждый раз ... Я хотел бы написать код об этом.:

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 является указание механизму БД, использовать ли транзакцию при выполнении SQL.Использование dbFailOnError в качестве второго параметра для DoCmd.RunSQL кажется неправильным.

Answer 2

По предложению @ David-W-Fenton я публикую здесь мой исправленный код для update().Я также включил код для writeSheetTable(), подпроцедуры, которая считывает в листе значения из Excel и записывает их во временную таблицу tempCorrection.Я использовал эту подпрограмму вместо 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 и запускаю его снова, он выдает ту же ошибку «Item Not Found».