I try to get an Excel sheet to ping multiple servers on a button press.

I followed all steps in the guide at
https://wintelgeeks.com/2016/02/11/script-to-ping-multiple-servers-using-excel/
but get a

"Compile Error: Invalid Outside Procedure".

I use Excel Office 365 on a Windows 2012 R2 server.

Sub PingSystem()
    ‘—-First clear the cells in Row B—————–
    ClearStatusCells
    ‘—————————————————
    Dim strcomputer As String
    Application.ScreenUpdating = True
    For introw = 2 To ActiveSheet.Cells(65536, 1).End(xlUp).Row
        strcomputer = ActiveSheet.Cells(introw, 1).Value
        ‘————Call ping function and post the output in the adjacent cell——-
        If Ping(strcomputer) = True Then
            strpingtest = “Online”
            ActiveSheet.Cells(introw, 2).Value = strpingtest
        Else
            ActiveSheet.Cells(introw, 2).Font.Color = RGB(200, 0, 0)
            ActiveSheet.Cells(introw, 2).Value = “Offline”
        End If
    Next
    MsgBox “Script Completed”
End Sub


Function Ping(strcomputer)
    Dim objshell, boolcode
    Set objshell = CreateObject(“wscript.shell”)
    boolcode = objshell.Run(“ping -n 1 -w 1000 ” & strcomputer, 0, True)
    If boolcode = 0 Then
        Ping = True
    Else
        Ping = False
    End If
End Function


Sub ClearStatusCells()
    Range(“B2:B1000”).Clear
End Sub

1 Answers

0
Mathieu Guindon On Best Solutions

Comment markers in VBA are ', but yours are : the VBA compiler doesn't recognize the character as an apostrophe and thus considers it part of an identifier.

Syntactically, an identifier sitting all alone on a line of code has to be a procedure call (or an unqualified member call against some global-scope object).

And a procedure call (or member call) can't be legal in a module's (declarations) section or anywhere outside a procedure's scope, since it's an executable statement.

And then the string delimiters " are , which also confuses the compiler.

Fix the single and the double quotes, the code will compile. Ctrl+H to find & replace =)

Rule of thumb, don't copy+paste code from blog posts if they're not formatted as code.

Public Sub PingSystem()
    Dim failed As Boolean
    On Error GoTo CleanFail
    'Application.ScreenUpdating = False

    Dim sheet As Worksheet
    Set sheet = ActiveSheet 'TODO set to a more specific sheet

    ClearStatusCells sheet

    Dim currentRow As Long
    For currentRow = 2 To sheet.Cells(sheet.Rows.Count, 1).End(xlUp).Row

        Dim host As Variant
        host = sheet.Cells(currentRow, 1).Value

        If Not IsError(host) Then

            Dim pingSuccess As Boolean
            pingSuccess = Ping(CStr(host))

            sheet.Cells(currentRow, 2).Value = IIf(pingSuccess, "Online", "Offline")
            sheet.Cells(currentRow, 2).Font.Color = IIf(pingSuccess, vbBlack, vbRed)

        End If

    Next
CleanExit:
    Application.ScreenUpdating = True
    If failed Then
        MsgBox "Script completed unexpectedly.", vbExclamation
    Else
        MsgBox "Script completed.", vbInformation
    End If
    Exit Sub
CleanFail:
    failed = True
    Resume CleanExit
End Sub

Private Function Ping(ByVal host As String) As Boolean
    With CreateObject("wscript.shell")
        Ping = .Run("ping -n 1 -w 1000 " & host, 0, True) = 0
    End With
End Function

Private Sub ClearStatusCells(ByVal sheet As Worksheet)
    sheet.Range("B2:B1000").Clear 'TODO use a named range?
End Sub