从Excel VBA运行访问查询

Question

我正在尝试在excel vba中编写一个宏，该宏仅打开一个访问数据库并在访问中运行2个查询。 似乎每两单击一次宏按钮即可运行并运行查询。 我的意思是，我单击它，它起作用了，第二次单击时我在第二次单击中得到了“运行时错误462”，第三次单击了，第四次单击又得到了错误，依此类推。 我似乎无法弄清楚为什么会这样。 这是下面的代码。

Sub QueryAccess1()

Dim db As Access.Application
Set db = New Access.Application
'set variables

db.Visible = True

db.OpenCurrentDatabase ("DatabaseFileName")
'open database

'--------------------------------------------------------------
On Error Resume Next

db.DoCmd.DeleteObject acTable, "TableName"
'if the table does not exist it skips this line
'--------------------------------------------------------------

On Error GoTo 0
'sets the error back to normal

'--------------------------------------------------------------
CurrentDb.Openrecordset ("QUERY1")
CurrentDb.Execute ("QUERY2")
'Calls the queries
'--------------------------------------------------------------

'--------------------------------------------------------------
db.CloseCurrentDatabase
db.Quit
'Closes Access
'--------------------------------------------------------------

Set db = Nothing

End Sub

当我得到错误时，我就得到它了

CurrentDb.Openrecordset ("QUERY1")

Answer 1

每两次单击错误可能是由于打开存在于其他位置的刚刚删除的表所致。 考虑通过MS Access的TableDefs集合进行迭代，以有条件地删除该对象（如果存在）。 然后，对操作查询重新排序，使其在OpenRecordset调用之前运行。

Public Sub RunQueries()
On Error Goto ErrHandle:
    ' DAO REQUIRES REFERENCE TO Microsoft Office X.X Access Database Engine Object Library
    Dim tbl As DAO.TableDef     
    Dim rs As DAO.Recordset
    Dim db As New Access.Application

    db.Visible = False                   ' KEEP DATABASE RUNNING IN BACKGROUND

    For Each tbl in db.CurrentDb.TableDefs
        If tbl.Name = "TableName" Then
            db.DoCmd.DeleteObject acTable, "TableName"
        End If
    Next tbl

    ' ASSUMED AN ACTION QUERY
    db.CurrentDb.Execute "QUERY2", dbFailOnError

    ' ASSUMED A SELECT QUERY BUT CALL BELOW IS REDUNDANT AS IT IS NEVER USED
    Set rs = db.CurrentDb.OpenRecordset("QUERY1")   

ExitHandle:
    ' FREE RESOURCES
    Set rst = Nothing: Set conn = Nothing
    db.CloseCurrentDatabase
    db.Quit
    Set db = Nothing
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
    Resume ExitHandle
End Sub

另外-避免在VBA中使用On Error Resume Next 。 始终主动预测和处理异常。

---

或者，不必使用make-table命令SELECT * INTO而不必担心以编程方式删除表，只需创建一次表，然后使用可以每次运行的DELETE和INSERT 。 当然，这假设表的结构（字段/类型）保持不变。

DELETE FROM myTable;

INSERT INTO myTable (Col1, Col2, Col3) 
SELECT Col1, Col2, Col3 FROM myOtherTable;

SELECT * FROM myTable;

---

最后，甚至没有理由甚至使用MS Access对象库来打开/关闭.GUI只是为了运行查询。 由于Access是一个数据库，因此可以像其他任何后端（即SQLite，Postgres，Oracle）一样连接到该数据库并从那里运行查询。 下面是一个ODBC连接示例，该驱动程序可以轻松替换为其他RBDMS的驱动程序。

Dim conn As Object, rst As Object

Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")

' OPEN CONNECTION
conn.Open "DRIVER={Microsoft Access Driver (*.mdb, *.accdb)};" _
            & "DBQ=C:\Path\To\Access\DB.accdb;"

' RUN ACTION QUERIES
conn.Execute "DELETE FROM myTable"
conn.Execute "INSERT INTO myTable (Col1, Col2, Col3)" _
               & " SELECT Col1, Col2, Col3 FROM myOtherTable"

' OPEN RECORDSET
rst.Open "SELECT * FROM myQuery", conn

' OUTPUT TO WORKSHEET
Worksheets("DATA").Range("A1").CopyFromRecordset rst
rst.Close

实际上，以上方法甚至不需要安装MS Access GUI .exe！ 另外，请确保将SELECT查询（甚至在INSERT一个）保存在Access中，并且不要作为VBA SQL字符串运行，因为Access引擎将为存储的查询保存最佳执行计划。

Answer 2

我设法使其与Parfait的方法一起使用。 这就是我所得到的。

Sub QueryAccess1()

Dim conn As Object, rst As Object
Dim path As String


Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")

path = Sheets("SheetName").Range("A1")

'OPEN CONNECTION
conn.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & path

'DELETES TABLE CONTENTS
conn.Execute "DELETE FROM [Table1]"

'RUN UNION QUERY AND INSERT INTO TABLE
rst.Open "SELECT * FROM [Query1]", conn
conn.Execute "INSERT INTO [Table1]  select * from [QUERY1] "

Set rst = Nothing: Set conn = Nothing

End Sub