Excel VBA使脚本异步

Question

我有一个脚本可以ping一个计算机列表,并根据它得到的结果改变它们的背景颜色.

我的问题是,它在运行时阻止整个excel文件.

所以我的问题是,如何让它运行异步？

这是代码:

'ping
Function sPing(sHost) As String

Dim oPing As Object, oRetStatus As Object

Set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
  ("select * from Win32_PingStatus where address = '" & sHost & "'")

For Each oRetStatus In oPing
    If IsNull(oRetStatus.StatusCode) Or oRetStatus.StatusCode <> 0 Then
        sPing = "timeout" 'oRetStatus.StatusCode <- error code
    Else
        sPing = sPing & vbTab & oRetStatus.ResponseTime & Chr(10)
    End If
Next
End Function

Sub pingall_Click()
Dim c As Range
Dim p As String

Application.ScreenUpdating = True

For Each c In ActiveSheet.Range("A1:N50")
    If Left(c, 7) = "172.21." Then
    p = sPing(c)
        If p = "timeout" Then
            c.Interior.ColorIndex = "3"
        ElseIf p < 16 And p > -1 Then
            c.Interior.ColorIndex = "4"
        ElseIf p > 15 And p < 51 Then
            c.Interior.ColorIndex = "6"
        ElseIf p > 50 And p < 4000 Then
            c.Interior.ColorIndex = "45"
        Else
            c.Interior.ColorIndex = "15"

        End If
    End If
Next c

Application.ScreenUpdating = False

Answer 1

不幸的是,由于VBA在单个线程中运行,因此不能对此做太多.

然而,您可以通过推出来引入一定程度的响应

VBA.DoEvents()

在您的代码中的各个地方,理想情况下在紧密循环中.在你的情况下,把它们放在包含的行之后For.这将暂停VBA并刷新事件队列,这将使Excel响应.

(切换屏幕更新是一个坏主意,因为如果函数意外终止,你可能会把事情处于错误的状态.如果我是你,我会删除这样做的行.)