Ping script (VBS)

Will ping list of machines and write results to log file, will also attempt to move old log files to an archive folder. You need to create a text file called "hosts.txt" and paste in the machine names that you wish to ping.

Option Explicit
'On Error Resume Next

Dim objFSO, objFile, Hostname, varHostsFileName, varLogFileName, varArchFld
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set objFSO = CreateObject("Scripting.FileSystemObject")

varHostsFileName = "Hosts.txt"
varLogFileName = "Ping" & Hour(Time) & Minute(Time) & Second(Time)
varArchFld = "Archive\" & Year(Date) & Month(Date) & Day(Date)

Archive

Set objFile = objFSO.OpenTextFile(varHostsFileName, ForReading)
Do Until objFile.AtEndOfStream
  HostName = objFile.ReadLine()
  If Ping(HostName) = "Online" Then
      LogFile Hostname & vbTab & "Online", varLogFileName
    Else
      LogFile Hostname & vbTab & "Offline", varLogFileName
  End If
Loop

objFile.Close

wScript.Quit

'Subs & Functions
Function Ping(HostName)
  'On Error Resume Next
  Dim colPingResults, objPingResult, strQuery
  strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & HostName & "'"
  Set colPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery(strQuery)
  For Each objPingResult In colPingResults
    If Not IsObject(objPingResult) Then
        Ping = "Offline"
      ElseIf objPingResult.StatusCode = 0 Then
        Ping = "Online"
      Else
        Ping = "Offline"
    End If
  Next
  Set colPingResults = Nothing
End Function

Sub LogFile(strInput, varLogFileName)
  'On Error Resume Next
  Dim objFSO, LogFile
  Const ForReading = 1, ForWriting = 2, ForAppending = 8
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set LogFile = objFSO.OpenTextFile(varLogFileName & ".log", ForAppending, True)
  LogFile.WriteLine(FormatDateTime(Date, 2) & vbTab & FormatDateTime(Time, 4) & ":" & Second(Time) & vbTab & strInput)
  LogFile.Close
End Sub


Sub CreateFld(Fld)
  'On Error Resume Next
  Dim objFSO
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  If Fld <> "" Then
    If Not objFSO.FolderExists(objFSO.GetParentFolderName(Fld)) Then
        Call CreateFld(objFSO.GetParentFolderName(Fld))
    End If
    objFSO.CreateFolder(Fld) & "\"
  End If
End Sub


Sub Archive
  On Error Resume Next
  Dim objFSO
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  CreateFld(varArchFld)
  objFSO.MoveFile "*.log", varArchFld & "\"
End Sub