VBA 코드로 IP 주소를 ping하고 결과를 Excel로 반환

VBA 코드로 IP 주소를 ping하고 결과를 Excel로 반환

저는 (엑셀 스프레드시트의) B열에 IP 접속을 테스트하고 c열에 IP 접속 여부를 기재하는 몇 가지 시각적 기본 코드(아래 참조)를 가지고 있습니다. connected이면 녹색으로 하고 다른 결과는 빨간색으로 하고 싶습니다.

또한 이 스크립트는 1시간 단위로 자동 실행할 수 있습니까, 아니면 1일 단위로 실행할 수 있습니까?

고마워, 앤디

Function GetPingResult(Host)

   Dim objPing As Object
   Dim objStatus As Object
   Dim strResult As String

   Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
       ExecQuery("Select * from Win32_PingStatus Where Address = '" & Host & "'")

   For Each objStatus In objPing
      Select Case objStatus.StatusCode
         Case 0: strResult = "Connected"
         Case 11001: strResult = "Buffer too small"
         Case 11002: strResult = "Destination net unreachable"
         Case 11003: strResult = "Destination host unreachable"
         Case 11004: strResult = "Destination protocol unreachable"
         Case 11005: strResult = "Destination port unreachable"
         Case 11006: strResult = "No resources"
         Case 11007: strResult = "Bad option"
         Case 11008: strResult = "Hardware error"
         Case 11009: strResult = "Packet too big"
         Case 11010: strResult = "Request timed out"
         Case 11011: strResult = "Bad request"
         Case 11012: strResult = "Bad route"
         Case 11013: strResult = "Time-To-Live (TTL) expired transit"
         Case 11014: strResult = "Time-To-Live (TTL) expired reassembly"
         Case 11015: strResult = "Parameter problem"
         Case 11016: strResult = "Source quench"
         Case 11017: strResult = "Option too big"
         Case 11018: strResult = "Bad destination"
         Case 11032: strResult = "Negotiating IPSEC"
         Case 11050: strResult = "General failure"
         Case Else: strResult = "Unknown host"
      End Select
      GetPingResult = strResult
   Next

   Set objPing = Nothing

End Function

Sub GetIPStatus()

  Dim Cell As Range
  Dim ipRng As Range
  Dim Result As String
  Dim Wks As Worksheet


Set Wks = Worksheets("Sheet1")

Set ipRng = Wks.Range("B3")
Set RngEnd = Wks.Cells(Rows.Count, ipRng.Column).End(xlUp)
Set ipRng = IIf(RngEnd.Row < ipRng.Row, ipRng, Wks.Range(ipRng, RngEnd))

  For Each Cell In ipRng
    Result = GetPingResult(Cell)
    Cell.Offset(0, 1) = Result
  Next Cell

End Sub

암호는 필요 없어요모든 셀을 빨간색으로 바꾼 다음 조건 형식을 추가하여 원할 때 녹색으로 만드십시오.

[ Home ] > [ Conditional Formating ]> [ New Rule ]> [ 수식을 사용합니다...

=C2="Connected"

녹색으로 포맷합니다.코드로 하고 싶은 경우는, For Each 루프에 몇개의 행을 추가할 수 있습니다.

If Result = "Connected" Then
    Cell.Offset(0,1).Font.Color = vbGreen
Else
    Cell.Offset(0,1).Font.Color = vbRed
End If

특정 간격으로 자동으로 실행되도록 하려면 이 링크를 확인하십시오.

관련 코드는 다음과 같습니다.

Public dTime As Date
Dim lNum As Long

Sub RunOnTime()
    dTime = Now + TimeSerial(0, 0, 10) 'Change this to set your interval
    Application.OnTime dTime, "RunOnTime"

    lNum = lNum + 1
    If lNum = 3 Then
        Run "CancelOnTime" 'You could probably omit an end time, but I think the program would eventually crash
    Else
        MsgBox lNum
    End If

End Sub

Sub CancelOnTime()
    Application.OnTime dTime, "RunOnTime", , False
End Sub

다음 중 하나를 포함할 것을 권장합니다.ThisWorkbook.Save라인은 크래시 없이 얼마나 오래 실행될지 말할 수 없기 때문에 한번에 며칠 동안 방치하면 문제가 생길 수 있습니다.

언급URL : https://stackoverflow.com/questions/21020077/ping-ip-address-with-vba-code-and-return-results-in-excel