Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Option Explicit
Sub sdfljd()
Dim WshShell As Object
Dim objExcel As Excel.Application, xlBook As Excel.Workbook, xlSheet As Excel.Worksheet
Dim IP As Variant, Ping As Long, i As Long, iEnd As Long, iTotal As Long
Dim blnCreatedXL As Boolean, blnOpenedXlBook As Boolean
Dim strFitxer As String, strName As String
strFitxer = "D:\armaris\armaris.xls"
strName = Right(strFitxer, Len(strFitxer) - InStrRev(strFitxer, "\"))
Set objExcel = GetObject(, "Excel.Application")
If objExcel Is Nothing Then
blnCreatedXL = True
Set objExcel = CreateObject("Excel.Application")
End If
On Error Resume Next
If Len(objExcel.Workbooks(strName).Name) = 0 Then
Set xlBook = objExcel.Workbooks.Open(strFitxer)
blnOpenedXlBook = True
Else
Set xlBook = objExcel.Workbooks(strName)
End If
Set xlSheet = xlBook.Sheets("ARMARIS")
iEnd = xlSheet.Cells(xlSheet.Rows.Count, "E").End(xlUp).Row
iTotal = iEnd - 2
Call ToggleEvents(False)
Set WshShell = CreateObject("WScript.Shell")
For i = 3 To iEnd
IP = xlSheet.Cells(i, "E").Value
Application.StatusBar = "Pinging " & i - 2 & " of " & iTotal & " - " & Format((i - 2) / iTotal, "Percent") & " ... " & IP
Ping = WshShell.Run("ping -n 4 " & IP, 0, True)
Select Case Ping
Case 0
xlSheet.Cells(i, "F").Value = "On Line"
xlSheet.Cells(i, "F").Interior.ColorIndex = 4
Case 1
xlSheet.Cells(i, "F").Value = "Off Line"
xlSheet.Cells(i, "F").Interior.ColorIndex = 3
End Select
Next i
If blnCreatedXL = True Then
objExcel.Quit
Else
If blnOpenedXlBook = True Then
xlBook.Close savechanges:=True 'false
End If
End If
Call ToggleEvents(True)
End Sub
Sub ToggleEvents(blnState As Boolean)
'Originally written by firefytr
With Application
.DisplayAlerts = blnState
.EnableEvents = blnState
.ScreenUpdating = blnState
If blnState Then .CutCopyMode = False
If blnState Then .StatusBar = False
End With
End Sub