A script that writes errors and should create a event-error

Question

this if it works should check the internet connection if there is a connection it does nothing. if there isn't a connection it should write a error in a txtfile if that happend 5 times it should create a error but it doesn't

I will show you the whole code that i have now and the piece of code that i want in a loop. I can't get it in the way i want. I want it to creat 1 Event-error after 5 times writing to the file.

this is the whole code i will put the code i want in a loop under it

strDirectory = "Z:\text2"
strFile = "\foutmelding.txt"
strText = "De connectie is verbroken" 
strWebsite = "www.helmichbeens.com"


If PingSite(strWebsite) Then WScript.Quit    'Website is pingable - no further action required
Set objFSO = CreateObject("Scripting.FileSystemObject")

RecordSingleEvent
Dim fout 
For fout = 1 To 5 : Do
    If fout = 5 Then Exit Do

        Set WshShell = WScript.CreateObject("WScript.Shell")
        Call WshShell.LogEvent(1, "Test Event")
Loop While False : next

'------------------------------------
'Record a single event in a text file
'------------------------------------
Sub RecordSingleEvent
    If Not objFSO.FolderExists(strDirectory) Then objFSO.CreateFolder(strDirectory)
    Set objTextFile = objFSO.OpenTextFile(strDirectory & strFile, 8, True)
    objTextFile.WriteLine(Now & strText)
    objTextFile.Close
End sub
'----------------
'Ping my web site
'----------------
Function PingSite( myWebsite )
    Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
    objHTTP.Open "GET", "http://" & myWebsite & "/", False
    objHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
    On Error Resume Next
    objHTTP.Send
    PingSite = (objHTTP.Status = 200)
    On Error Goto 0
End Function
'-----------------------------------------------
'Counts the number of lines inside the text file
'-----------------------------------------------
Function EventCount(fout)
    strData = objFSO.OpenTextFile(strDirectory & strFile,ForReading).ReadAll
    arrLines = Split(strData,vbCrLf)
    EventCount = UBound(arrLines)
End Function

This is the whole code, and it doesnt work correctly becaus it creats a event-log rightaway and it should do that after the script has written 5 times to the textfile

here is the code that writes to a textfile

Sub RecordSingleEvent
    If Not objFSO.FolderExists(strDirectory) Then objFSO.CreateFolder(strDirectory)
    Set objTextFile = objFSO.OpenTextFile(strDirectory & strFile, 8, True)
    objTextFile.WriteLine(Now & strText)
    objTextFile.Close
End sub

and here is the code but this part doesnt not work or atleast i think it is this part

Dim fout 
For fout = 1 To 5 : Do
    If fout = 5 Then Exit Do

        Set WshShell = WScript.CreateObject("WScript.Shell")
        Call WshShell.LogEvent(1, "Test Event")
Loop While False : next

Function EventCount(fout)
    strData = objFSO.OpenTextFile(strDirectory & strFile,ForReading).ReadAll
    arrLines = Split(strData,vbCrLf)
    EventCount = UBound(arrLines)
End Function

this is the not working part and I don't know what to do anymore so can you please take a look at it tank you very much.

btw: this code can be very usefull for a network administrator

Answer 1

You do something very weird with your for do while false next loop. The early escape can also be done with the for loop itself:

Dim fout, WshShell
Set WshShell = WScript.CreateObject("WScript.Shell") ' Get this out of the loop, you only have to create it once.

For fout = 1 To 5
    if fout = 5 then exit for
    Call WshShell.LogEvent(1, "Test Event")
next

I would recommend using Option Explicit. You use lots of variables I never see initialized. Furthermore, you use ForReading this is not an VBScript keyword, you have to assign it the proper value. You can make it a Global Constant:

Const ForReading = 1

You would have spotted that if you used Option Explicit.

Try to make function that will work on their parameters and not external global variables. So refactor the EventCount function to:

Function EventCount(logFilePath)
    dim strData, arrLines
    strData = objFSO.OpenTextFile(logFilePath, ForReading).ReadAll
    arrLines = Split(strData,vbCrLf)
    EventCount = UBound(arrLines) + 1
End Function

Did you notice that fout is never used in the EventCount function?

You also want to increment the EventCount with 1, because an array is zero indexed (ubound will return -1 for empty arrays). Count is alway defined as the exact amount of items in contrary to the index.

EDIT: reading your logic, I think you want to do this:

Dim fout, objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Ping the website five times
For fout = 1 to 5
    If PingSite(strWebsite) Then Exit For    'Website is pingable - no further action required

    ' The website was not pingable, write it to a logfile
    RecordSingleEvent

    ' The website was not pingable five times in a row, log it to the eventlogger
    If fout = 5 then
        Set WshShell = WScript.CreateObject("WScript.Shell")
        Call WshShell.LogEvent(1, "Test Event")
    End if

Next

' We are done.
WScript.Quit