Identificação de máquinas online - Ping em Ip Excel Servidores

Identificação de máquinas online - Ping em Ip Excel Servidores

Essa foi uma ideia enviada pelo amigo Alcides R. Teixeira que perguntou se era possível criar uma planilha que verificasse periodicamente se as máquinas continuavam online fazendo Ping.

Desta forma encontrei uma função VBA na página http://www.ehow.com/how_12103340_use-vb-vba-perform-ping-test.html e a adaptei para que fossem retornadas as informações relevantes para este acompanhamento e criei uma planilha aonde é possível colocar todas as máquinas listadas.

Foi ainda incluso o agendamento para que a cada 1 minuto a planilha atualizasse os dados e identificasse se todos os endereços IP continuam em rede.

Para que a planilha inicie a verificação, primeiro é necessário que sejam digitados os locais na planilha.

Na coluna situação nós temos o percentual de Pings com pacotes entregues, são feitas 4 tentativas de entrega e dividido o total de pacotes concluídos pelo total de tentativas.

Na coluna Tempo você tem o tempo mínimo, máximo e a média de entrega dos pacotes.

Abaixo o código fonte da planilha e depois o download.

Public Sub lsTestarLocais()
    On Error Resume Next

    Dim lUltimaLinhaAtiva   As Long
    Dim lContador           As Long
    Dim lDados()            As String

    lUltimaLinhaAtiva = Worksheets("Painel").Cells(Worksheets("Painel").Rows.Count, 1).End(xlUp).Row

    For lContador = 2 To lUltimaLinhaAtiva
        lDados = Split(myPingFunction(Worksheets("Painel").Range("A" & lContador).Value), "||")

        Worksheets("Painel").Range("C" & lContador).Value = ""

        If lDados(1) <> "novamente." Then
            If Mid(lDados(8), 36, 1) = 0 Then
                Worksheets("Painel").Range("B" & lContador).Value = 0
            Else
                Worksheets("Painel").Range("B" & lContador).Value = Mid(lDados(8), 21, 1) / Mid(lDados(8), 36, 1)
                Worksheets("Painel").Range("C" & lContador).Value = Replace(Replace(Replace(lDados(11), "M¡", "Mí"), "M ", "Má"), "M‚", "Mé")
            End If
        Else
            Worksheets("Painel").Range("B" & lContador).Value = 0
        End If
    Next lContador

    Worksheets("Painel").Range("I2").Value = Now()

    lsAgendamento
End Sub

Function myPingFunction(hostAddress As String) As String
    On Error Resume Next

    Dim FSObj As Object
    Dim shellObj As Object
    Dim tmpFileObj As Object
    Dim sLine As String
    Dim sFilename As String
    Dim sRetorno()    As String

    Set FSObj = CreateObject("Scripting.FileSystemObject")
    Set shellObj = CreateObject("Wscript.Shell")

    sFilename = FSObj.GetTempName
    shellObj.Run "cmd /c ping " & hostAddress & " >" & sFilename, 0, True

    Set tmpFileObj = FSObj.OpenTextFile(sFilename, 1)

    Do While tmpFileObj.AtEndOfStream <> True
        sLine = tmpFileObj.Readline
        myPingFunction = myPingFunction & Trim(sLine) & "||"
    Loop

    tmpFileObj.Close
    FSObj.DeleteFile (sFilename)
End Function

Sub lsAgendamento()
    Application.OnTime Now + TimeValue("00:01:00"), "lsTestarLocais"
End Sub

Abraço

Marcos Rieper