小编Div*_*in3的帖子

Excel VBA使脚本异步

我有一个脚本可以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 …
Run Code Online (Sandbox Code Playgroud)

excel vba asynchronous excel-vba

7
推荐指数
1
解决办法
1万
查看次数

Ping功能使整个excel表缓慢/无响应

我有一个函数从excel列表中ping计算机并获取它们的ping值.

当脚本运行时,excel完全没有响应.我可以解决这个问题DoEvents,这使它更具响应性.

但是,该问题在函数到达脱机计算机时启动.当它等待离线PC的响应时,Excel再次冻结,脚本不会跳转到下一台PC,直到它从实际的"超时".

由于默认的ping超时值是4000毫秒,如果我的列表中有100台计算机,其中50台已关闭,这意味着我必须等待额外的3,3分钟才能完成脚本,并且还会阻止整个Excel ,使其在持续时间内无法使用.

我的问题是,是否有任何方法可以使这更快或更敏感或更聪明?

实际代码:

功能:

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 & "'")
 DoEvents
    For Each oRetStatus In oPing
        DoEvents
            If IsNull(oRetStatus.StatusCode) Or oRetStatus.StatusCode <> 0 Then
            sPing = "timeout" 'oRetStatus.StatusCode <- error code
        Else
            sPing = sPing & vbTab & oRetStatus.ResponseTime
        End If
    Next
End Function
Run Code Online (Sandbox Code Playgroud)

主要:

Sub pingall_Click()
Dim c As Range
Dim …
Run Code Online (Sandbox Code Playgroud)

excel performance vba asynchronous excel-vba

2
推荐指数
1
解决办法
1001
查看次数

标签 统计

asynchronous ×2

excel ×2

excel-vba ×2

vba ×2

performance ×1