A recent discussion between MVPs made me retrieve an old piece of code I had and thought it might serves others.

Certain code can rely on external servers/PC/… (think of table relinking, external attachments, …) and if they fail to connect, we often get errors that do not properly reflect the real issue. As such, it make sense, prior to trying to work with an external component, that we first validate that we can communicate with it. In networks where PINGing is enabled, the following function will permit you to determine if the component is accessible or not.

'---------------------------------------------------------------------------------------
' Procedure : PC_IsAccessible
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Determine if a PC is reacheable by validating if it can be PINGed
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
' Refs      : https://docs.microsoft.com/en-us/previous-versions/windows/desktop/wmipicmp/win32-pingstatus
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sHost     : IP address or Name of the PC to ping against
'
' Output
' ~~~~~~
' The function returns a boolean value
'   True    = PC could be reached successfully
'   False   = PC could not be reached
'
' Usage:
' ~~~~~~
' PC_IsAccessible("192.168.0.1")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2016-01-11              Initial Release
' 2         2019-05-05              Header Updated
'                                   Code cleanup
'                                   Error Handler Updated
'---------------------------------------------------------------------------------------
Function PC_IsAccessible(sHost As String) As Boolean
    On Error GoTo Error_Handler
    Dim oWMI                  As Object
    Dim oPingStatuses         As Object
    Dim oPingStatus           As Object
    Dim sSQL                  As String

    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    sSQL = "SELECT * FROM Win32_PingStatus WHERE Address='" & sHost & "'"
    Set oPingStatuses = oWMI.ExecQuery(sSQL)
    For Each oPingStatus In oPingStatuses
        If oPingStatus.StatusCode = 0 Then
            PC_IsAccessible = True
            Exit For
        End If
    Next

Error_Handler_Exit:
    On Error Resume Next
    If Not oPingStatus Is Nothing Then Set oPingStatus = Nothing
    If Not oPingStatuses Is Nothing Then Set oPingStatuses = Nothing
    If Not oWMI Is Nothing Then Set oWMI = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: PC_IsAccessible" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function