Code:
Sub CheckWindowsSchedulerLogs()
Dim countF As Long
Dim fText As String
Dim fDate1 As Long, fDate2 As Long
Dim MALogDeficit As Long
Dim oFSO As New FileSystemObject
Dim oFS As Object
Dim a As Long, f As Long, rc As Long
Dim m As String
Dim NewSheet As Variant
Dim LastRow As Long
Dim mf As Boolean
Dim c
Dim LogLocation As String
MALogDeficit = Sheets(1).TBLogDeficit.Value
fDate1 = Now() - MALogDeficit / 24
LogLocation = Sheets("Main").Range("LogLocation").Value
With Application.FileSearch 'Search for the file begins.
.NewSearch
.LookIn = LogLocation
.SearchSubFolders = True 'Including sub folder to ensure ALL files are scanned.
.FileType = msoFileTypeAllFiles 'Get everything
.FileName = "*"
If .Execute() > 0 Then 'Execute is > 0 if something is found
'If Excel errors here, it's probably because the sheet already exists. Delete it if this is the case.
'If that is not the case then something went horribly wrong.
On Error GoTo rcHandler
Set NewSheet = Sheets.Add(Type:=xlWorksheet, After:=Sheets("Job List"))
NewSheet.Name = "WSLC_" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2)
GoTo rcExit
rcHandler:
Sheets("WSLC_" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2)).Delete
NewSheet.Name = "WSLC_" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2)
rcExit:
On Error GoTo 0
For countF = 1 To .FoundFiles.Count 'For each file from 1 to whatever...
'This creates an instance of the MS Scripting Runtime FileSystemObject class
Set oFS = CreateObject("Scripting.FileSystemObject")
fDate2 = FileDateTime(.FoundFiles(countF))
If fDate2 >= fDate1 Then
f = f + 1 '
Set oFS = oFSO.OpenTextFile(.FoundFiles(countF))
Sheets("WSLC_" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2)).Range("B1000").End(xlUp).Offset(2, -1).Value = .FoundFiles(countF)
LastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
a = 0
Do Until oFS.AtEndOfStream 'Loop through the text file reading in every line.
fText = oFS.ReadLine
Select Case True
Case InStr(1, fText, "%put") 'No logging of %put "ERROR:".
rc = rc - 1 'where there is a false positive, minus 1 from the rc count. It doesn't matter as long as rc is <=0
Case InStr(1, fText, "*LIBNAM*") 'No logging of LIBNAME ACL's".
rc = rc - 1
Case InStr(1, fText, "SASUSER registry") 'No logging of multi-session incompatibility".
rc = rc - 1
Case InStr(1, fText, "Compression was disabled") 'No logging of small, uncompressed datasets.
rc = rc - 1
Case InStr(1, fText, "confirming logoff") 'No logging of Mainframe logoff issue.
rc = rc - 1
Case InStr(1, fText, "printed on page") 'No logging of the fact an error was printed.
rc = rc - 1
Case InStr(1, fText, "HUGEWRK") 'No logging of Mainframe sign-in issue.
rc = rc - 1
mf = True
Case InStr(1, fText, "LIBNAME statement") And mf = True 'When we have the mainframe sign-on issue, also tells us the libname has an error.
rc = rc - 1
mf = False 'After the mainframe libname error we want to start capturing other libname errors as normal.
Case InStr(1, fText, "ERROR:")
Sheets("WSLC_" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2)).Range("B" & LastRow + a).Value = fText
a = a + 1
rc = rc + 1000 'ensure rc is > 0 to capture the fact at least one error occurred.
Case InStr(1, fText, "WARNING:")
Sheets("WSLC_" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2)).Range("B" & LastRow + a).Value = fText
a = a + 1
rc = rc + 1000
End Select
Loop
'For any job, search through the Job List for the Windows Scheduler job with the same name.
'Assess whether the rc (return code) is GT or LE 0. If there are no errors, rc will be <=0.
'If rc is > 0 then using a column offset of "today", mark the job as an N due to the warning or error we have found.
'Otherwise mark it as a "Y" because it's worked fine.
For Each c In Range(Sheets("Log").Range("A1"), Sheets("Log").Range("A1000").End(xlUp))
If c <> "" Then 'We can't use Len(c) on empty cells so skip any empties.
If InStr(1, .FoundFiles(countF), Left(c.Value, Len(c) - 3)) > 0 Then
If rc > 0 Then: c.Offset(0, Day(Date)) = "N"
If rc <= 0 Then: c.Offset(0, Day(Date)) = "Y"
Exit For
Else
End If
Else 'c is empty.
End If
Next c
Else 'fDate2 >= fDate1 not true, file is too old.
End If
Set oFS = Nothing
a = 0
mf = False
rc = 0
Next countF 'Go to the next file in the list.
Else
MsgBox "Something went wrong, I can't find any files."
End If '.Execute() > 0
End With 'Application.FileSearch
Sheets("WSLC_" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2)).Range("A1").Value = "There were " & countF & " files found and " & f & " files read within the time constraint."
Sheets("WSLC_" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2)).Range("A2").Value = "There are " & Application.WorksheetFunction.CountA(Range(Cells(3, "A"), Cells(1000, "A"))) & " reported error and/or warning messages."
Sheets("WSLC_" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2)).Range("A1:A2").Font.Bold = True
Columns(1).EntireColumn.AutoFit
Columns(2).EntireColumn.AutoFit
Columns(3).EntireColumn.AutoFit
End SubThe above is some very old vba in sheet I've been given (along with a new role)
the application.filesearch has been removed by microsoft (gg)
Any ideas how to fix this or what to replace it with?
