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

Posted by helmich on Stack Overflow See other posts from Stack Overflow or by helmich
Published on 2013-11-06T09:31:29Z Indexed on 2013/11/06 9:53 UTC
Read the original article Hit count: 190

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

© Stack Overflow or respective owner

Related posts about function

Related posts about vbscript