Question

I have been given a task of creating a script that takes a log file (date is in the filename), pulls the data and posts it in event manager. I have a script that works as it should I know the script is ugly so please be gentle. I'm looking for 2 things.

  1. some days nothing has happened and no log for the day was created. when this happens my script causes all kinds of slowness in the PC. I need help with a way for the script to not do its task if no new file has been added to the logs folder.
  2. I would like a little help cleaning up the script.

Like i said i'm very new to this and i used scripts found on the web and fit them to do what i needed them to do. any help would be greatly appricated.

Option Explicit

Const ForReading = 1

Dim strfolder
Dim FSO
Dim FLD
Dim fil
Dim strOldName
Dim strNewName
Dim strFileParts
Dim objShell
Dim objFSO
Dim objFolder
Dim strFileName
Dim objFile
Dim objTextFile
Dim strNextLine
Dim arrServiceList
Dim i


strFolder = "C:\Logs\"


Set objShell = CreateObject ("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(strFolder)
Set objShell = CreateObject ("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile ("C:\Logs\logCatchAll.log", ForReading)

For Each strFileName in objFolder.Items
    If len(objFSO.GetExtensionName(strFileName)) > 0 Then
        Set objFile = objFSO.GetFile(strFolder & strFileName.Name)
        If DateDiff("H",objFile.DateLastModified,Now()) > 24 Then
            objFSO.DeleteFile(strFolder & strFileName.Name),True
        End If
    End If
 next
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FLD = FSO.GetFolder(strfolder)
For Each fil in FLD.Files
    strOldName = fil.Path
    If InStr(strOldName, "-") > 0 Then
        strFileParts = Split(strOldName, "-")
        strNewName = strFileParts(0) & ".log"
        FSO.MoveFile strOldName, strNewName
    End If
 Next
 Set FLD = Nothing
 Set FSO = Nothing   


 Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.Readline
arrServiceList = Split(strNextLine , ",")
For i = 3 to Ubound(arrServiceList)
objshell.LogEvent 4, arrServiceList(i)
 Loop 
Was it helpful?

Solution

  1. You can block your Dim'd variables
  2. You are reactivating the objShell to many times
  3. You have a for loop at the bottom of your code without a Next statement.
  4. You don't need to iterate through the log file until it reaches AtEndOfStream, just store it in a variable first.
  5. You can use the same objFSO more than once if your not resetting the object.
  6. You need to include error handling so you know where your code breaks.

Revised code.

Option Explicit

'Handle errors manually.
On Error Resume Next

'Set Constants
Const ForReading = 1

'Set Strings
Dim strFolder, strOldName, strNewName, strFileName, strFileParts, strNextLine, TFStrings
strFolder = "C:\Logs\"

'Set Objects
Dim objShell, objFSO, objFolder, objFile, objTextFile
Set objShell = CreateObject ("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objShell.Namespace(strFolder)
TFStrings = split(objFSO.OpenTextFile("C:\Logs\logCatchAll.log", ForReading).ReadAll, vbcrlf)

'Set Other Variables
Dim FLD, fil, arrServiceList, i, executed
executed = false


'Delete file procedure...
For Each strFileName in objFolder.Items
    If len(objFSO.GetExtensionName(strFileName)) > 0 Then
        Set objFile = objFSO.GetFile(strFolder & strFileName.Name)
        If DateDiff("H",objFile.DateLastModified,Now()) > 24 Then
            objFSO.DeleteFile(strFolder & strFileName.Name),True
        executed = true
        End If
    End If
Next

If executed then
    If err.number <> 0 then
        'File was found, but delete was unsuccessful, log failure of delete. 
        executed = false
        err.clear
    Else
        'Delete file procedure executed successfully. Lets move on. 
        executed = false
    End If
Else
    'No file was found within the conditions. log failure of search. 
End if

'Move file and rename procedure...
Set FLD = objFSO.GetFolder(strfolder)
For Each fil in FLD.Files
   strOldName = fil.Path
   If InStr(strOldName, "-") > 0 Then
       strFileParts = Split(strOldName, "-")
       strNewName = strFileParts(0) & ".log"
       objFSO.MoveFile strOldName, strNewName
       executed = true
   End If
Next
Set FLD = Nothing
Set FSO = Nothing   

If executed then
    If err.number <> 0 then
        'File was found, but move was unsuccessful, log failure of move. 
        executed = false
        err.clear
    Else
        'Move file procedure executed successfully. Lets move on. 
        executed = false
    End If
Else
    'No file was found within the conditions. log failure of search.
End if

For Each line in TFStrings
    strNextLine = line
    arrServiceList = Split(strNextLine , ",")
    For i = 3 to Ubound(arrServiceList)
        objshell.LogEvent 4, arrServiceList(i)
    Next
Next
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top