Question

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

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

从Excel VBA运行访问查询

2 个答案: