How to make this ping test with timer more efficient?

Question

I wrote a small ducktaped VBA script which pings servers every 15 mins or so. If a server's status is anything other than "Alive", the server and timestamp is written to another worksheet called "Log".

Sub Countup()
 Dim CountDown As Date
 CountDown = Now + TimeValue("00:00:01")
 Application.OnTime CountDown, "Auto_Open"
End Sub
Sub Auto_Open()
 Dim count As Range
 Set count = Worksheets("Servers").Range("A1:A1")
 count.Value = count.Value - TimeSerial(0, 0, 1)
 If count <= 0 Then
 count = Worksheets("Servers").Range("C1:C1")
 Call GetComputerToPing
 Call Countup
 Exit Sub
 End If
 Call Countup
End Sub
Public Sub addDataToTable(ByVal strTableName As String, ByVal strData As String, ByVal Col As Integer)
 Dim lLastRow As Long
 Dim iHeader As Integer
 With ActiveSheet.ListObjects(strTableName)
 'find the last row of the list
 lLastRow = ActiveSheet.ListObjects(strTableName).ListRows.count
 'shift from an extra row if list has header
 If .Sort.Header = xlYes Then
 iHeader = 1
 Else
 iHeader = 0
 End If
 End With
 'add the data a row after the end of the list
 ActiveSheet.Cells(lLastRow + 1 + iHeader, Col).Value = strData
End Sub
'Requires references to Microsoft Scripting Runtime and Windows Script Host Object Model.
'Set these in Tools - References in VB Editor.
Function sPing(sHost) As String
 On Error Resume Next
 sHost = Trim(sHost)
 Dim ipaddress As String
 Dim computername As String
 Dim Model As String
 Dim memory As Long
 Dim oPing As Object, oRetStatus As Object
 Set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}")
 Set oPing = oPing.execquery("select * from win32_pingstatus where address ='" & sHost & "'")
 For Each oRetStatus In oPing
 If IsNull(oRetStatus.statuscode) Then
 sPing = "Dead"
 ElseIf oRetStatus.statuscode = 11010 Then
 sPing = "Request Timed Out"
 ElseIf oRetStatus.statuscode = 11013 Then
 sPing = "Destination Host Unreachable"
 Else
 sPing = "Alive"
 End If
 Next
 Set oPing = Nothing
 Set oRetStatus = Nothing
End Function
Sub GetComputerToPing()
 Application.DisplayAlerts = False
 'On Error Resume Next
 Dim applicationobject As Object
 Dim i As Integer
 i = 3 'row to start checking servers from
 Do Until Cells(i, 1) = ""
 'If Cells(i, 1) <> "" Then
 'If Cells(i, 2) = "Request Timed Out" Or Cells(i, 2) = "" Or Cells(i, 2) = "Dead" Then
 Cells(i, 2) = sPing(Cells(i, 1))
 Cells(i, 3) = Now()
 'log it to Log
 If Cells(i, 2).Value <> "Alive" Then
 Call copytest(i)
 End If 
 'End If
 'End If
 i = i + 1
 Loop
Set applicationobject = Nothing
End Sub
Function findlast_Row() As Long
 Dim ws As Worksheet
 Set ws = ThisWorkbook.Sheets("Log")
 With ws
 findlast_Row = .Range("A" & .Rows.count).End(xlUp).Row
 End With
End Function
Sub copytest(ByVal intRow As Integer)
 'screens for last row in log sheet
 iLastRow = findlast_Row() + 1
 Worksheets("Log").Range("A" & CStr(iLastRow) & ":E" & CStr(iLastRow)).Value = Worksheets("Servers").Range("A" & CStr(intRow) & ":E" & CStr(intRow)).Value
End Sub

Is there another way (or better way) to do the countdown timer?

• JMax: And what was your question again?
• phill: Is there another way (or better way) to do the countdown timer?
• JMax: Ok. That's clearer. I personaly don't see another way but let's see if anyone has a great idea.
• Mathieu Guindon: I think it's "duct tape", not "duck tape"... poor ducks!

Answer 1

Using Application.OnTime is a very neat way of implementing your timer, but I have a hard time figuring out how "pings servers every 15 mins or so" translates to Now + TimeValue("00:00:01"). Note that since VBA is single-threaded, OnTime doesn't mean your code will run at that specific time, rather that when Excel isn't busy doing something else, it will queue your method for synchronous execution, like any other event handler code.

That said, your naming and access modifiers lack consistency (I guess that's what you meant with "duct-taped"?).

Observations

• You're using ListObject.ListRows.Count, but you're puzzling your way into adding a new row - why aren't you using ListObject.ListRows.Add() which returns the added row?
• In sPing function (awful name), I would refactor this ElseIf construct into some Private Function GetPingResult(StatusCode As Long) As String, and assign the function's return value once; also you made the default value "Alive" - if there's an error code you haven't accounted for, your function returns "Alive" which is possibly wrong.

Nitpicks

• This is VBA - stick to PascalCasing for all identifiers. It will make your code read consistently with the language itself.
• The default access modifier for Sub and Function is Public - thus, either specify it or leave it out, but don't do both. If the unspecified ones are supposed to be Private, be explicit about it.
• The language's convention for underscores in procedure names, is only for methods that implement interface methods (e.g. event handlers). Avoid it.
• Worse than Hungarian notation (strTableName As String), is inconsistent Hungarian notation, especially in the same method signature (why isn't it iCol As Integer then?). Avoid it (Hungarian notation, that is!).

I know this is an incomplete review, but I think you have enough meat here anyway.