ping.vba

ping.vba

#Taken from: http://scriptorium.serve-it.nl/view.php?sid=68
#and
#https://www.mrexcel.com/forum/excel-questions/391426-ping-list-servers-excel.html
Option Explicit

'Requires references to Microsoft Scripting Runtime and Windows Script Host Object Model.
'Set these in Tools - References in VB Editor.


Public Function PingResult(sHost As String) As String
    Dim sResponse As String
    
    sResponse = sPing(sHost)
    If InStr(sResponse, "TTL") Then
        PingResult = "Online"
    Else
        PingResult = "Offline"
    End If
    
End Function


Private Function sPing(sHost As String) As String

    Dim oFSO As FileSystemObject, oShell As WshShell, oTempFile As TextStream
    Dim sFilename As String
    
    Set oFSO = New FileSystemObject
    Set oShell = New WshShell
    
    sFilename = oFSO.GetTempName
    oShell.Run "%comspec% /c ping -n 1 " & sHost & " > " & sFilename, 0, True
    
    Set oTempFile = oFSO.OpenTextFile(sFilename, ForReading)
    sPing = oTempFile.ReadAll
    oTempFile.Close
    oFSO.DeleteFile (sFilename)

End Function
 

Public Sub TestPing()
    MsgBox sPing(InputBox("Enter hostname to test"))
End Sub
            
================ Alternate version =================
            
Option Explicit

'Requires references to Microsoft Scripting Runtime and Windows Script Host Object Model.
'Set these in Tools - References in VB Editor.


Public Function PingResult(sHost As String) As String
    Dim sResponse As String
    
    sResponse = sPing(sHost)
    If InStr(sResponse, "Reply from") Then
        PingResult = "Online"
    Else
        PingResult = "Offline"
    End If
    
End Function


Private Function sPing(sHost As String) As String

    Dim oFSO As FileSystemObject, oShell As WshShell, oTempFile As TextStream
    Dim sFilename As String
    
    Set oFSO = New FileSystemObject
    Set oShell = New WshShell
    
    sFilename = oFSO.GetTempName
    oShell.Run "%comspec% /c ping -n 1 " & sHost & " > " & sFilename, 0, True
    
    Set oTempFile = oFSO.OpenTextFile(sFilename, ForReading)
    sPing = oTempFile.ReadAll
    oTempFile.Close
    oFSO.DeleteFile (sFilename)

End Function
 

Public Sub TestPing()
    MsgBox sPing(InputBox("Enter hostname to test"))
End Sub