Ping l’indirizzo IP con codice VBA e restituisce risultati in Excel

Ho un codice di base visivo (vedi sotto) che verifica una connessione IP nella colonna B (di un foglio di calcolo excel) e mette se è connesso o non raggiungibile nella colonna c, mi stavo chiedendo se potessi aiutarmi vorrebbe che fosse verde se ‘connesso’, e qualsiasi altro risultato sarebbe rosso.

Inoltre, questo script può essere eseguito automaticamente su base oraria o giornaliera?

Molte grazie, Andy

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 

Non hai bisogno di codice per questo. Trasforma tutte le celle in rosso, quindi aggiungi la formattazione condizionale per renderla verde quando vuoi.

Home> Formattazione condizionale> Nuova regola> Utilizza una formula …

 =C2="Connected" 

e formattare in verde. Se vuoi farlo in codice, puoi aggiungere alcune linee nel tuo ciclo For Each

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

Per farlo funzionare automaticamente a determinati intervalli, controlla questo link.

Ecco il codice rilevante:

 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 

Vorrei raccomandare di includere una riga ThisWorkbook.Save perché non posso parlare di quanto tempo funzionerà senza crash, e immagino che potresti vedere i problemi se lo hai lasciato per giorni alla volta.