循环一个函数?

Loop a function?

是否可以循环一个函数直到某个项目 = TRUE?

我正在尝试 ping 服务器... 一旦建立连接,或 Ping = TRUE,程序就会执行。 如果未建立连接,则 ping 将重复直到为真。

到目前为止,我的代码如下。 如果为 TRUE,MyProgram 将打开。 如果为 False,将再次调用该函数。但这并没有发生...实际上什么也没有发生,它只是退出了。

非常感谢任何帮助。 如果有人知道完成此任务的更有效方法,请告诉我。 谢谢!

     Function Ping
        Dim oPing, oRetStatus, bReturn
        Set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address='" & "strHost" & "'")

        For Each oRetStatus In oPing
            If IsNull(oRetStatus.StatusCode) Or oRetStatus.StatusCode <> 0 Then
                bReturn = False
            Else
                bReturn = True
            End If
            Set oRetStatus = Nothing
        Next
        Set oPing = Nothing

    Ping = bReturn
    End Function

If Ping Then
    Call MyProgram
Else
    Call PingSub
End If

Sub MyProgram
    Dim objShell
        Set objShell = WScript.CreateObject( "WScript.Shell" )
        objShell.Run("\Path\To\My\Program.exe")
        Set objShell = Nothing
End Sub

Sub PingSub
    Call Ping
End Sub

那将是一个递归函数。

https://msdn.microsoft.com/en-us/library/81tad23s.aspx 我假设你正在使用 VBA

这是来自 MS

的示例

这样试试:

Option Explicit
Dim MyLoop,strComputer,objPing,objStatus
MyLoop = True
While MyLoop = True
    strComputer = "smtp.gmail.com"
    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\").ExecQuery _
    ("select * from Win32_PingStatus where address = '" & strComputer & "'")
    For Each objStatus in objPing
        If objStatus.Statuscode = 0 Then
            MyLoop = False
            Call MyProgram()
            wscript.quit
        End If
    Next
    Pause(10) 'To sleep for 10 secondes
Wend
'**********************************************************************************************
 Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
 End Sub
'**********************************************************************************************
Sub MyProgram()
Dim objShell
Set objShell = CreateObject( "WScript.Shell" )
objShell.Run("calc.exe")
Set objShell = Nothing
End Sub
'**********************************************************************************************