Почему Win32_PingStatus возвращает недоступный сервер, но пинг вручную работает

У меня есть книга excel со списком имен хостов. В настоящее время я использую приведенный ниже код, чтобы получить IP-адрес каждого имени хоста и изменить цвет ячейки на красный и зеленый в зависимости от состояния сервера. Этот код работает в 99% случаев, но в некоторых случаях сервер отображается как недоступный. Но когда я вручную использую ping в cmd, он показывает, что сервер работает. Пингование вручную также показывает, что поездка туда и обратно не занимает особенно много времени, поэтому я не думаю, что тайм-аут является виновником.

У кого-нибудь есть идеи, почему это происходит?

Private Sub GetServerInfo_Click()
    Dim i As Integer
    Dim rowCount As Integer
    rowCount = Worksheets("Inventory_Repository").Cells.SpecialCells(xlCellTypeLastCell).Row

    For i = 3 To rowCount
        Cells(i, 10).Value = sPing(Cells(i, 4).Value)
        If InStr(Cells(i, 10), "Unavailable") > 0 Then
            Cells(i, 10).Interior.Color = RGB(255, 0, 0)
        Else
            Cells(i, 10).Interior.Color = RGB(0, 255, 0)
        End If
    Next i
    MsgBox ("IP has been updated")
End Sub

Function sPing(sHost) As String

    Dim oPing As Object, oRetStatus As Object

    Set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
      ("select * from Win32_PingStatus where address = '" & sHost & "'")

    For Each oRetStatus In oPing
        If IsNull(oRetStatus.StatusCode) Or oRetStatus.StatusCode <> 0 Then
            sPing = "Unavailable"
        Else
            sPing = oRetStatus.ProtocolAddress
        End If
    Next

End Function

server excel vba ping wmi
person Jay    schedule 06.08.2015    source источник

Ответы (1)


arrow_upward
0
arrow_downward

Было две проблемы, из-за которых я не мог пропинговать некоторые серверы.

Первая небольшая проблема заключалась в том, что после одного из имен хостов был дополнительный пробел. Это предотвратит проверку связи Win32_PingStatus с правильным сервером. Обязательно удалите все пробелы до и после имен хостов.

Второй ошибкой было время ожидания. По умолчанию время ожидания составляет 1000 мс. Однако для более загруженных серверов это иногда может занять немного больше времени. Я добавил это в свой код, чтобы увеличить время ожидания до 4000 мс, что разрешило все серверы, которые периодически терпели неудачу при проверке связи.

Set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
      ("select * from Win32_PingStatus where address = '" & sHost & "' and timeout = 4000")
person Jay    schedule 07.08.2015