表刷新后的Excel VBA QueryTable回调函数

时间:2013-08-07 14:38:40

标签: multithreading excel vba excel-vba

我正在编写/维护一个Excel VBA应用程序,其中有多个QueryTable链接到MS sql server数据库。应用程序的用户可以通过操作Excel文档上的各种UI控件来更改每个表的SQL查询。

我遇到的QueryTables的一个问题是使用多线程。文档上的每个QueryTable都具有在运行查询后必须还原的原始状态。例如,如果QueryTable1具有

的基本查询
Select * from example_table

并且用户在控件上选择了某些输入来创建

Select * from example_table Where object_oid = '10'

我需要恢复原始状态。下面的代码是我目前正在完成此操作的快照

Sub RefreshDataQuery()
'Dependencies: Microsoft Scripting Runtime (Tools->References) for Dictionary (HashTable) object

Dim querySheet As Worksheet
Dim interface As Worksheet

Set querySheet = Worksheets("QTable")
Set interface = Worksheets("Interface")

Dim sh As Worksheet
Dim qt As QueryTable
Dim qtDict As New Scripting.Dictionary

Set qtDict = UtilFunctions.CollectAllQueryTablesToDict

Set qt = qtDict.Item("Query from fred2")

''' Building SQL Query String '''
Dim sqlQueryString As String
Dim originalQueryCache As String
originalQueryCache = qt.CommandText
sqlQueryString = qt.CommandText

QueryBuilder.BuildSQLQueryStringFromInterface interface, sqlQueryString

MsgBox sqlQueryString

qt.CommandText = sqlQueryString

If Not qt Is Nothing Then
    qt.Refresh
Else
    'Error Messages and handling here
    ' Cut out to keep code short
End If


''' CLEAN UP '''

'Restore the original base SQL query
' Problem is here
' This, or any other altering statement, will error out if the query is still refreshing
qt.CommandText = originalQueryCache
' Other original state restoring code below...

' Free the dictionary
Set qtDict = Nothing


End Sub

理想情况下,如果我用另一种现代语言编写它,我会创建一个回调函数或使用完成通知程序在我自己的线程中运行刷新。我花了很多时间研究如何获得qt.Refresh调用的回调函数,但我没有运气。我知道我可以“破解”这一点,但我宁愿不参与不良行为,因为很多人将来必须维持这种做法。

此应用程序必须支持Excel 2010版本及更高版本

那么如何为在不同线程中运行的VBA函数创建回调函数呢?或者,我应该考虑另一种方法吗?

1 个答案:

答案 0 :(得分:1)

除了通过自定义类模块和WithEvents关键字之外,不会公开QueryTables事件。首先,创建一个名为CQtEvents的自定义类模块并将其放入其中:

Private WithEvents mQryTble As QueryTable
Private msOldSql As String

Public Property Set QryTble(ByVal QryTble As QueryTable): Set mQryTble = QryTble: End Property
Public Property Get QryTble() As QueryTable: Set QryTble = mQryTble: End Property
Public Property Let OldSql(ByVal sOldSql As String): msOldSql = sOldSql: End Property
Public Property Get OldSql() As String: OldSql = msOldSql: End Property

Private Sub mQryTble_AfterRefresh(ByVal Success As Boolean)

    Me.QryTble.CommandText = Me.OldSql

End Sub

这是两个属性:一个用于保存QueryTable,另一个用于存储旧的sql。然后你的程序看起来像

Sub RefreshDataQuery()

    Dim interface As Worksheet
    Dim qt As QueryTable
    Dim qtDict As New Scripting.Dictionary
    Dim clsQtEvents As CQtEvents
    Dim sqlQueryString As String

    Set qtDict = UtilFunctions.CollectAllQueryTablesToDict
    Set qt = qtDict.Item("Query from fred2")

    sqlQueryString = qt.CommandText
    QueryBuilder.BuildSQLQueryStringFromInterface interface, sqlQueryString

    'Create class for events and store old sql
    Set clsQtEvents = New CQtEvents
    Set clsQtEvents.QryTble = qt
    clsQtEvents.OldSql = qt.CommandText

    qt.CommandText = sqlQueryString

    If Not qt Is Nothing Then
        qt.Refresh 'after this is done, the event in the class will fire
    Else
        'Error Messages and handling here
    End If

End Sub

因为您使用WithEvents定义mQryTble,所以它在类中公开了它的两个事件(BeforeRefresh和AfterRefresh)。通过将CQtEvents.QryTble设置为QueryTable,该类将侦听该QueryTable上的事件。 CommandText在更改之前存储在OldSql中。然后,当完成刷新时,事件将触发并恢复CommandText。当然不会在事件中完成刷新,但我认为如果刷新或重新处理它,你需要旧的sql语句。

接下来,您应该考虑创建一个集合类来保存一堆QtEvents实例。我假设你的代码处理一个例子,但你真的做得更多。然后,您可以将CollectAllQueryTables移动到该集合类中,并将BuildSQL部分移动到CQtEvents类中。