Trouble with Case Statement

I have this code and can't get the program to generate email.  I believe the issue is with the case statement.  I can't figure it out.  

' This script processes the list of files in the directory’s subfolders (i.e. recursively)  passed as argument
' and returns 1 if any file is older than "age_threshold" minutes

Dim RPT1
Dim RPT2
Dim RPT3
Dim RPT4
Dim RPT5
Dim RPT6
Dim RPT7
Dim RPT8
Dim RPT9
Dim RPT10
Dim RPT11
Dim RPT12
Dim RPT13
Dim RPT14
Dim RPT15
Dim RPT16
Dim RPT17
Dim RPT18
Dim RPT19
Dim RPT20
Dim RPT21
Dim RPT22
Dim RPT23
Dim RPT24
Dim RPT25
Dim RPT26
Dim RPT27
Dim RPT28
Dim RPT29
Dim RPT30
Dim RPT31
Dim RPT32
Dim RPT33
Dim RPT34
Dim RPT35
Dim RPT36
Dim RPT37
Dim RPT38
Dim RPT39
Dim RPT40
Dim RPT41
Dim RPT42
Dim RPT43
Dim RPT44
Dim RPT45
Dim RPT46
Dim RPT47
Dim RPT48
Dim RPT49
Dim RPT50
Dim RPT51
Dim RPT52
Dim RPT53
Dim RPT54
Dim RPT55
Dim RPT56
Dim RPT57
Dim RPT58
Dim RPT59
Dim RPT60
Dim RPT61
Dim RPT62
Dim RPT63
Dim RPT64
Dim RPT65
Dim RPT66
Dim RPT67
Dim RPT68
Dim RPT69
Dim RPT70
Dim RPT71
Dim RPT72
Dim RPT73
Dim RPT74
Dim RPT75
Dim RPT76
Dim RPT77
Dim RPT78
Dim RPT79
Dim RPT80
Dim RPT81
Dim RPT82
Dim RPT83
Dim RPT84
Dim RPT85
Dim RPT86
Dim RPT87
Dim RPT88
Dim RPT89
Dim RPT90
Dim RPT91
Dim RPT92
Dim RPT93
Dim RPT94
Dim RPT95
Dim RPT96
Dim RPT97
Dim RPT98
Dim RPT99
Dim RPT100
Dim RPT101
Dim RPT102
Dim RPT103
Dim RPT104
Dim RPT105
Dim RPT106
Dim RPT107
Dim RPT108
Dim RPT109
Dim RPT110
Dim RPT111
Dim RPT112
Dim RPT113
Dim RPT114
Dim RPT115
Dim RPT116
Dim RPT117

RPT1= "ORSCH 3DAYOR REPORT"
RPT2= "ORSCH 3DAYORGI REPORT"
RPT3= "ORSCH 3DAYORSDC REPORT"
RPT4= "ACTIVEDIETS REPORT"
RPT5= "CLINICAL 1F MEDSURG"
RPT6= "CLINICAL 2F DCU"
RPT7= "CLINICAL 2F ICUCCU"
RPT8= "CLINICAL 3F MEDSURG"
RPT9= "CLINICAL 4F MEDSURG"
RPT10= "CLINICAL 5F MEDSURG"
RPT11= "CLINICAL CBH"
RPT12= "CLINICAL L&DPPNICU"
RPT13= "CLINICAL NTSICU"
RPT14= "CLINICAL OVERFLOW"
RPT15= "CLINICAL RIP"
RPT16= "DIET NOURISHMENT REPORT"
RPT17= "EMAR IVSS 1F MEDSURG"
RPT18= "EMAR IVSS 2F DCU"
RPT19= "EMAR IVSS 2F ICUCCU"
RPT20= "EMAR IVSS 3F MEDSURG"
RPT21= "EMAR IVSS 4F MEDSURG"
RPT22= "EMAR IVSS 5FMEDSURG"
RPT23= "EMAR IVSS CBH"
RPT24= "EMAR IVSS L&DPPNICU"
RPT25= "EMAR IVSS NTSICU"
RPT26= "EMAR IVSS RIP"
RPT27= "ICUERAND DCU"
RPT28= "ICUERAND ICU"
RPT29= "ICUERAND NTSICU"
RPT30= "ICUERAND OVERFLOW"
RPT31= "LABSUM 2F DCU"
RPT32= "LABSUM 3FMEDSURG"
RPT33= "LABSUM ALBUMINPREA"
RPT34= "LABSUM CBH"
RPT35= "LABSUM MN"
RPT36= "LABSUM NTICU"
RPT37= "LABSUM OVERFLOW"
RPT38= "LABSUM RIP"
RPT39= "LABSUM-2FICU&CCU"
RPT40= "MAR CBH"
RPT41= "MAR OVERFLOW"
RPT42= "MAR RIP"
RPT43= "MSERAND 3FLOOR"
RPT44= "MSERAND 4FLOOR"
RPT45= "MSERAND 5FLOOR"
RPT46= "MSERAND OVERFLOW"
RPT47= "MSERAND RIP"
RPT48= "PATIENTSNAPSHOT 1F MEDSURG REPORT"
RPT49= "PATIENTSNAPSHOT 2F DCU REPORT"
RPT50= "PATIENTSNAPSHOT 2F ICUCCU REPORT"
RPT51= "PATIENTSNAPSHOT 3F MEDSURG REPORT"
RPT52= "PATIENTSNAPSHOT 4F MEDSURG REPORT"
RPT53= "PATIENTSNAPSHOT 5F MEDSURG REPORT"
RPT54= "PATIENTSNAPSHOT CBH REPORT"
RPT55= "PATIENTSNAPSHOT L&DPPNICU REPORT"
RPT56= "PATIENTSNAPSHOT NTSICU REPORT"
RPT57= "PATIENTSNAPSHOT RIP REPORT"
RPT58= "POM 1F MEDSURG"
RPT59= "POM 2F DCU"
RPT60= "POM 2F ICUCCU"
RPT61= "POM 3F MEDSURG"
RPT62= "POM 4F MedSurg"
RPT63= "POM 5F MEDSURG"
RPT64= "POM CBH"
RPT65= "POM L&DPPNICU"
RPT66= "POM NTSICU"
RPT67= "POM OVERFLOW"
RPT68= "POM RIP"
RPT69= "MAR 1F A40"
RPT70= "MAR 2F ICUCCU"
RPT71= "MAR 2FDCU"
RPT72= "MAR 3F MEDSURG"
RPT73= "MAR 4F MEDSURG"
RPT74= "MAR 5F MedSurg"
RPT75= "MAR L&DPPNICU"
RPT76= "MAR NTSICU"
RPT77= "ADM CBHOB"
RPT78= "ADM INPTAUTH"
RPT79= "ADM PREREG"
RPT80= "CAREPLAN 2FECDCU"
RPT81= "CAREPLAN 2FEDICU"
RPT82= "CAREPLAN 2FMNADCU"
RPT83= "CAREPLAN 2FMSADCU"
RPT84= "CAREPLAN 2FWCDCU"
RPT85= "CAREPLAN 2MSBICU"
RPT86= "CAREPLAN 3 FECSURG"
RPT87= "CAREPLAN 3 FWCSURG"
RPT88= "CAREPLAN 3 MNASURG"
RPT89= "CAREPLAN 3 MSAMSURG"
RPT90= "CAREPLAN 3 MSASURG"
RPT91= "CAREPLAN 4 FEAONC"
RPT92= "CAREPLAN 4 FEBONC"
RPT93= "CAREPLAN 4 FWONC"
RPT94= "CAREPLAN 5 MNA NEURO"
RPT95= "CAREPLAN 5 MSBNEURO"
RPT96= "CAREPLAN CBH"
RPT97= "CAREPLAN E1F1"
RPT98= "CAREPLAN E1F2"
RPT99= "CAREPLAN EAHA"
RPT100= "CAREPLAN RIP"
RPT101= "SCH CARD REPORT"
RPT102= "SCH CCLPHYS REPORT"
RPT103= "SCH COTC REPORT"
RPT104= "SCH ECHCNPS REPORT"
RPT105= "SCH ECHCPEDMDS REPORT"
RPT106= "SCH ECHCSOCWKR REPORT"
RPT107= "SCH EEG REPORTS"
RPT108= "SCH FADEPT REPORT"
RPT109= "SCH FHEM REPORT"
RPT110= "SCH HBOC REPORT"
RPT111= "SCH ITDEPT REPORT"
RPT112= "SCH LMFC REPORT"
RPT113= "SCH OPAIDE REPORT"
RPT114= "SCH OPALL REPORT"
RPT115= "SCH PATRNS REPORT"
RPT116= "SCH PATROOMS REPORT"
RPT117= "SCH WOS REPORT"

' File age threshold in minutes
Dim old_file_name
Dim old_file_not_found
old_file_found = 0
scanFolder("C:\Summit\Test\")

if old_file_found = 1 then
      Sendmail
end if

sub scanFolder(objFolder)

Dim fso, f
Dim age
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.getFolder(objFolder)

For Each file in f.Files
age = DateDiff("n", file.DateLastModified, Now)

Select Case fileage
      Case 1, 2, 3
            'check the known 60min reports
            For i = 1 To 3
                  If ((age > 60) And (LCase(Right(File.Name, 4) = ".enc")) And InStr(1, File.Name, RPT(i), 1) = 1) Then
                                    old_file_found = 1
                                    old_file_name = old_file_name & vbCrLf & File.Name & chr(10)
                                    'Exit For
                  End If
            Next
      Case 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68
            'check the known 120min reports
            For i = 4 To 68
                  If ((age > 120) And (LCase(Right(File.Name, 4) = ".enc")) And InStr(1, File.Name, RPT(i), 1) = 1) Then
                                    old_file_found = 1
                                    old_file_name = old_file_name & vbCrLf & File.Name  & chr(10)
                                    'Exit For
                  End If
            Next
      Case 69, 70, 71, 72, 73, 74, 75, 76
            'check the known 180min reports
            For i = 69 To 76
                  If ((age > 180) And (LCase(Right(File.Name, 4) = ".enc")) And InStr(1, File.Name, RPT(i), 1) = 1) Then
                                    old_file_found = 1
                                    old_file_name = old_file_name & vbCrLf & File.Name & chr(10)
                                    'Exit For
                  End If
            Next
      Case 77, 78, 79
            'check the known 720min reports
            For i = 77 To 79
                  If ((age > 720) And (LCase(Right(File.Name, 4) = ".enc")) And InStr(1, File.Name, RPT(i), 1) = 1) Then
                                    old_file_found = 1
                                    old_file_name = old_file_name & vbCrLf & File.Name & chr(10)
                                    'Exit For
                  End If
            Next
      Case 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117
            'check the known 720min reports
            For i = 80 To 117
                  If ((age > 1440) And (LCase(Right(File.Name, 4) = ".enc")) And InStr(1, File.Name, RPT(i), 1) = 1) Then
                                    old_file_found = 1
                                    old_file_name = old_file_name & vbCrLf & File.Name & chr(10)
                                    'Exit For
                  End If
            Next
End Select
Next

dim subfolderPath, ObjSubfolder
For each subfolderPath in f.SubFolders
      Set ObjSubfolder = fso.GetFolder(subfolderPath)
      scanFolder(ObjSubfolder)
      Set ObjSubfolder = nothing
Next

End Sub

Sub Sendmail()
      Set objMessage = CreateObject("CDO.Message")

      'Send Message
      strToEmailAddress = "me@mydomain.com"
      strFromEmailAddress = "me@mydomain.com"
      strSMTPServer = "mydomain.com"
      strSMTPServerPort = 25
      
      objMessage.Subject = "Old file(s) found!"
      objMessage.From = "Old file scanner <" & strFromEmailAddress & ">"""
      objMessage.To = strToEmailAddress
      objMessage.TextBody = "Old file found: " & old_file_name & chr(32) & FormatDateTime(file.DateLastModified,0)
      objMessage.Configuration.Fields.Item _
      ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
      objMessage.Configuration.Fields.Item _
      ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer
      objMessage.Configuration.Fields.Item _
      ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = strSMTPServerPort
      objMessage.Configuration.Fields.Update
      objMessage.Send

End Sub
williamss132Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

MontoyaProcess Improvement MgrCommented:
Ill look at this a little closer later, but...

' File age threshold in minutes
Dim old_file_name
Dim old_file_not_found
old_file_found = 0

where did you declare old_file_found?
0
QlemoBatchelor, Developer and EE Topic AdvisorCommented:
The case statement is assuming you use an array RPT(), not single variables for each report file. The beginning of your code should look like this:
Dim RPT(117)
RPT(1) = "ORSCH 3DAYOR REPORT"
RPT(2) = "ORSCH 3DAYORGI REPORT"
' and so on

Open in new window

Further, you should make use of the range operator in case, as suggested earlier, instead of enumerating all values from x to y. E.g.
      Case 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117

Open in new window

is better written as
      Case 80 to 117

Open in new window

0
williamss132Author Commented:
When I change all of my array value to this:
Dim RPT(117)
RPT(1) = "ORSCH 3DAYOR REPORT"
RPT(2) = "ORSCH 3DAYORGI REPORT"

I get error - Name Redefined.  This is because it's using the same name: RPT over and over again.

I tried using Case 80 to 117 and get an error when I do it like this.
0
Introduction to Web Design

Develop a strong foundation and understanding of web design by learning HTML, CSS, and additional tools to help you develop your own website.

Bill PrewCommented:
I've seen this question popping up a couple of times and I have an alternate approach I'm going to write up that I think might be a bit simpler in the end.  Stay tuned...

~bp
0
Bill PrewCommented:
Okay, take a look at this and see if you think it might work for you. I decided to use a Dictionary object to hold the ages for each named folder, that makes things a lot easier to maintain in the future since you can then reference those key / values pairs by the file name, not by there relative position in an array, etc.  Let me know what questions you have.

' This script processes the list of files in the directory’s subfolders (i.e. recursively)  passed as argument
' and returns 1 if any file is older than "age_threshold" minutes

' Define the folder to scan, and the extension of files to check
strBaseDir = "C:\Summit\Test\"
strBaseExt = "enc"

' Create a file system object for use in the script
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Create dictionary object to store file name / age pairs
' (set for case insensitive key matching)
Set dicAge = CreateObject("Scripting.Dictionary")
dicAge.CompareMode = vbTextCompare

' Call routine to load key / value pairs into dictionary
' These will specify the age to keep for each file name
InitAges()

' Initialize results variables for recursive scan
intFoundCount = 0
strFoundList = ""

' Recursively scan from the base folder looking for matches
ScanFolder(objFSO.GetFolder(strBaseDir))

' If any files found then send email with results
If intFoundCount > 0 Then
    SendMail
End If

' Recursive subroutine to look for "old" files in a folder
Sub ScanFolder(objFolder)

    ' Check each file in the folder
    For Each objFile in objFolder.Files
        ' Make sure it matches the extension we want
        If LCase(objFSO.GetExtensionName(objFile.Path)) = LCase(strBaseExt) Then
            ' Get the base name (no extension) and see if it's in the dictionary
            strBaseName = objFSO.GetBaseName(objFile.Path)
            If dicAge.Exists(strBaseName) Then
                ' Check if its age exceeds the threshold for this file
                If DateDiff("n", objFile.DateLastModified, Now) > dicAge.Item(strBaseName) Then
                    ' Add to list of "old" files
                    intFoundCount = intFoundCount + 1
                    strFoundList = strFoundList & vbCrLf & objFile.Path & vbCrLf
                End If
            End If
        End If
    Next

    ' Recursive logic to drill down into all subfolders of this folder
    For Each objSubFolder In objFolder.SubFolders
        ScanFolder(objSubFolder)
    Next
End Sub

' Subountine to email with search results
Sub Sendmail()
      Set objMessage = CreateObject("CDO.Message")

      'Send Message
      strToEmailAddress = "me@mydomain.com"
      strFromEmailAddress = "me@mydomain.com"
      strSMTPServer = "mydomain.com"
      strSMTPServerPort = 25
      
      objMessage.Subject = "Old file(s) found!"
      objMessage.From = "Old file scanner <" & strFromEmailAddress & ">"""
      objMessage.To = strToEmailAddress
      objMessage.TextBody = "Old file found: " & strFoundList & chr(32) & FormatDateTime(file.DateLastModified,0)
      objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
      objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer
      objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = strSMTPServerPort
      objMessage.Configuration.Fields.Update
      objMessage.Send
End Sub 

' Subroutine to initialize the ages dictionary
Sub InitAges()
    dicAge.Add "ORSCH 3DAYOR REPORT", 60
    dicAge.Add "ORSCH 3DAYORGI REPORT", 60
    dicAge.Add "ORSCH 3DAYORSDC REPORT", 60
    dicAge.Add "ACTIVEDIETS REPORT", 120
    dicAge.Add "CLINICAL 1F MEDSURG", 120
    dicAge.Add "CLINICAL 2F DCU", 120
    dicAge.Add "CLINICAL 2F ICUCCU", 120
    dicAge.Add "CLINICAL 3F MEDSURG", 120
    dicAge.Add "CLINICAL 4F MEDSURG", 120
    dicAge.Add "CLINICAL 5F MEDSURG", 120
    dicAge.Add "CLINICAL CBH", 120
    dicAge.Add "CLINICAL L&DPPNICU", 120
    dicAge.Add "CLINICAL NTSICU", 120
    dicAge.Add "CLINICAL OVERFLOW", 120
    dicAge.Add "CLINICAL RIP", 120
    dicAge.Add "DIET NOURISHMENT REPORT", 120
    dicAge.Add "EMAR IVSS 1F MEDSURG", 120
    dicAge.Add "EMAR IVSS 2F DCU", 120
    dicAge.Add "EMAR IVSS 2F ICUCCU", 120
    dicAge.Add "EMAR IVSS 3F MEDSURG", 120
    dicAge.Add "EMAR IVSS 4F MEDSURG", 120
    dicAge.Add "EMAR IVSS 5FMEDSURG", 120
    dicAge.Add "EMAR IVSS CBH", 120
    dicAge.Add "EMAR IVSS L&DPPNICU", 120
    dicAge.Add "EMAR IVSS NTSICU", 120
    dicAge.Add "EMAR IVSS RIP", 120
    dicAge.Add "ICUERAND DCU", 120
    dicAge.Add "ICUERAND ICU", 120
    dicAge.Add "ICUERAND NTSICU", 120
    dicAge.Add "ICUERAND OVERFLOW", 120
    dicAge.Add "LABSUM 2F DCU", 120
    dicAge.Add "LABSUM 3FMEDSURG", 120
    dicAge.Add "LABSUM ALBUMINPREA", 120
    dicAge.Add "LABSUM CBH", 120
    dicAge.Add "LABSUM MN", 120
    dicAge.Add "LABSUM NTICU", 120
    dicAge.Add "LABSUM OVERFLOW", 120
    dicAge.Add "LABSUM RIP", 120
    dicAge.Add "LABSUM-2FICU&CCU", 120
    dicAge.Add "MAR CBH", 120
    dicAge.Add "MAR OVERFLOW", 120
    dicAge.Add "MAR RIP", 120
    dicAge.Add "MSERAND 3FLOOR", 120
    dicAge.Add "MSERAND 4FLOOR", 120
    dicAge.Add "MSERAND 5FLOOR", 120
    dicAge.Add "MSERAND OVERFLOW", 120
    dicAge.Add "MSERAND RIP", 120
    dicAge.Add "PATIENTSNAPSHOT 1F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 2F DCU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 2F ICUCCU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 3F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 4F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 5F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT CBH REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT L&DPPNICU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT NTSICU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT RIP REPORT", 120
    dicAge.Add "POM 1F MEDSURG", 120
    dicAge.Add "POM 2F DCU", 120
    dicAge.Add "POM 2F ICUCCU", 120
    dicAge.Add "POM 3F MEDSURG", 120
    dicAge.Add "POM 4F MedSurg", 120
    dicAge.Add "POM 5F MEDSURG", 120
    dicAge.Add "POM CBH", 120
    dicAge.Add "POM L&DPPNICU", 120
    dicAge.Add "POM NTSICU", 120
    dicAge.Add "POM OVERFLOW", 120
    dicAge.Add "POM RIP", 120
    dicAge.Add "MAR 1F A40", 180
    dicAge.Add "MAR 2F ICUCCU", 180
    dicAge.Add "MAR 2FDCU", 180
    dicAge.Add "MAR 3F MEDSURG", 180
    dicAge.Add "MAR 4F MEDSURG", 180
    dicAge.Add "MAR 5F MedSurg", 180
    dicAge.Add "MAR L&DPPNICU", 180
    dicAge.Add "MAR NTSICU", 180
    dicAge.Add "ADM CBHOB", 720
    dicAge.Add "ADM INPTAUTH", 720
    dicAge.Add "ADM PREREG", 720
    dicAge.Add "CAREPLAN 2FECDCU", 1440
    dicAge.Add "CAREPLAN 2FEDICU", 1440
    dicAge.Add "CAREPLAN 2FMNADCU", 1440
    dicAge.Add "CAREPLAN 2FMSADCU", 1440
    dicAge.Add "CAREPLAN 2FWCDCU", 1440
    dicAge.Add "CAREPLAN 2MSBICU", 1440
    dicAge.Add "CAREPLAN 3 FECSURG", 1440
    dicAge.Add "CAREPLAN 3 FWCSURG", 1440
    dicAge.Add "CAREPLAN 3 MNASURG", 1440
    dicAge.Add "CAREPLAN 3 MSAMSURG", 1440
    dicAge.Add "CAREPLAN 3 MSASURG", 1440
    dicAge.Add "CAREPLAN 4 FEAONC", 1440
    dicAge.Add "CAREPLAN 4 FEBONC", 1440
    dicAge.Add "CAREPLAN 4 FWONC", 1440
    dicAge.Add "CAREPLAN 5 MNA NEURO", 1440
    dicAge.Add "CAREPLAN 5 MSBNEURO", 1440
    dicAge.Add "CAREPLAN CBH", 1440
    dicAge.Add "CAREPLAN E1F1", 1440
    dicAge.Add "CAREPLAN E1F2", 1440
    dicAge.Add "CAREPLAN EAHA", 1440
    dicAge.Add "CAREPLAN RIP", 1440
    dicAge.Add "SCH CARD REPORT", 1440
    dicAge.Add "SCH CCLPHYS REPORT", 1440
    dicAge.Add "SCH COTC REPORT", 1440
    dicAge.Add "SCH ECHCNPS REPORT", 1440
    dicAge.Add "SCH ECHCPEDMDS REPORT", 1440
    dicAge.Add "SCH ECHCSOCWKR REPORT", 1440
    dicAge.Add "SCH EEG REPORTS", 1440
    dicAge.Add "SCH FADEPT REPORT", 1440
    dicAge.Add "SCH FHEM REPORT", 1440
    dicAge.Add "SCH HBOC REPORT", 1440
    dicAge.Add "SCH ITDEPT REPORT", 1440
    dicAge.Add "SCH LMFC REPORT", 1440
    dicAge.Add "SCH OPAIDE REPORT", 1440
    dicAge.Add "SCH OPALL REPORT", 1440
    dicAge.Add "SCH PATRNS REPORT", 1440
    dicAge.Add "SCH PATROOMS REPORT", 1440
    dicAge.Add "SCH WOS REPORT", 1440
End Sub

Open in new window

~bp
0
williamss132Author Commented:
bp,

thanks for the redesign!

If DateDiff("n", objFile.DateLastModified, Now) > dicAge.Item(strBaseName) Then
--In reviewing I see that the Age check is using the strBaseName

Seems like it should parse the strBaseName out to pull the minutes.  How does it work?

When I run this, nothing happens.  I updated the email features with my email.
0
williamss132Author Commented:
I can't get it perfect but shouldn't the dicAge pull the 2nd part of the array?
Like this?
If DateDiff("n", objFile.DateLastModified, Now) > dicAge(1) Then
0
Bill PrewCommented:
A dictionary isn't actually an array, it's more like a very lightweight database table.  When you add an element to the dictionary, you specify a character key for that entry, and then a single value to be associated with that key.  So in my implementation, I used the base name (no extension) of the files that you wanted to check, and then associated a numeric value with them of the number of days for that file that you wanted to keep.  So this creates a small lookup table in memory that conceptually looks like this:

dictionary structureOnce we have added entries to the dictionary, we can check if a specific key exists using the Exists() method passing it a key, and if it does exist we can then get the value that is associated with that key using the Item() method.

So in the code I provided (which I did test here and did work) you see that I was getting the age to keep value from the dictionary using:

dicAge.Item(strBaseName)

This will use the string in strBaseName as the key into the dictionary table, and then return the age that was loaded in and associated with that key.

Does that help at all, feel free to keep the questions coming, these can be a little tricky if you haven't seen them before, but once you get the hang of them are quite useful in the right situation.

~bp
0
williamss132Author Commented:
dc,

I place the code just like you have it above.  I updated my email info.  

I have a bunch of old files with the names listed.  The files are days old.  When I run it, nothing happens.  You say you tested it succesfully?
0
williamss132Author Commented:
Maybe it's the file name.  example of one of the files: 'SCH CCLPHYS REPORT.PDF.enc'

Would I have to make a change since I have an encrypted pdf file?
0
Bill PrewCommented:
No, that shouldn't matter.

What changes did you make to the script I posted?

~bp
0
williamss132Author Commented:
The only thing I change were my email address and the email server.
0
Bill PrewCommented:
I did not test the actual sending of email, since those were not valid addresses, etc.  But the logic that got me there worked.

I just ran a test again, with the following change:

' If any files found then send email with results
If intFoundCount > 0 Then
    Wscript.Echo intFoundCount
    Wscript.Echo strFoundList
    'SendMail
End If

Open in new window

and it displayed the 4 files in my test area, as it should have.

Did you ever have that email code working?  Does it send an email at all, or none?
0
williamss132Author Commented:
I have this working with a bunch of If statements.  My code with the If statements is working.  This code has the same exact email code.  

Let me try the change above.
0
williamss132Author Commented:
Attched is my current code with If statements - this is in production.
oldestfile-IF.txt
0
williamss132Author Commented:
I made the change above an it doesn't work.
0
Bill PrewCommented:
It didn't display anything to the screen?

~bp
0
williamss132Author Commented:
No errors or messages.
0
Bill PrewCommented:
Okay, I added more logging, please run again and let me know what it displays.

' This script processes the list of files in the directory’s subfolders (i.e. recursively)  passed as argument
' and returns 1 if any file is older than "age_threshold" minutes

' Define the folder to scan, and the extension of files to check
strBaseDir = "C:\Summit\Test\"
strBaseExt = "enc"

' Create a file system object for use in the script
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Create dictionary object to store file name / age pairs
' (set for case insensitive key matching)
Set dicAge = CreateObject("Scripting.Dictionary")
dicAge.CompareMode = vbTextCompare

' Call routine to load key / value pairs into dictionary
' These will specify the age to keep for each file name
InitAges()

' Initialize results variables for recursive scan
intFoundCount = 0
strFoundList = ""

' Recursively scan from the base folder looking for matches
ScanFolder(objFSO.GetFolder(strBaseDir))

' If any files found then send email with results
If intFoundCount > 0 Then
    Wscript.Echo intFoundCount
    Wscript.Echo strFoundList
    'SendMail
End If

' Recursive subroutine to look for "old" files in a folder
Sub ScanFolder(objFolder)
    Wscript.Echo "Scanning folder: " & objFolder.Path

    ' Check each file in the folder
    For Each objFile in objFolder.Files
        Wscript.Echo "Checking file: " & objFile.Path & "," & objFSO.GetExtensionName(objFile.Path) & "," objFSO.GetBaseName(objFile.Path)
        ' Make sure it matches the extension we want
        If LCase(objFSO.GetExtensionName(objFile.Path)) = LCase(strBaseExt) Then
            Wscript.Echo "Matched base ext"
            ' Get the base name (no extension) and see if it's in the dictionary
            strBaseName = objFSO.GetBaseName(objFile.Path)
            If dicAge.Exists(strBaseName) Then
                Wscript.Echo "Found in dict, " & DateDiff("n", objFile.DateLastModified, Now) > dicAge.Item(strBaseName)
                ' Check if its age exceeds the threshold for this file
                If DateDiff("n", objFile.DateLastModified, Now) > dicAge.Item(strBaseName) Then
                    Wscript.Echo "Matched date diff"
                    ' Add to list of "old" files
                    intFoundCount = intFoundCount + 1
                    strFoundList = strFoundList & vbCrLf & objFile.Path & vbCrLf
                End If
            End If
        End If
    Next

    ' Recursive logic to drill down into all subfolders of this folder
    For Each objSubFolder In objFolder.SubFolders
        ScanFolder(objSubFolder)
    Next
End Sub

' Subountine to email with search results
Sub Sendmail()
      Set objMessage = CreateObject("CDO.Message")

      'Send Message
      strToEmailAddress = "me@mydomain.com"
      strFromEmailAddress = "me@mydomain.com"
      strSMTPServer = "mydomain.com"
      strSMTPServerPort = 25
      
      objMessage.Subject = "Old file(s) found!"
      objMessage.From = "Old file scanner <" & strFromEmailAddress & ">"""
      objMessage.To = strToEmailAddress
      objMessage.TextBody = "Old file found: " & strFoundList & chr(32) & FormatDateTime(file.DateLastModified,0)
      objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
      objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer
      objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = strSMTPServerPort
      objMessage.Configuration.Fields.Update
      objMessage.Send
End Sub 

' Subroutine to initialize the ages dictionary
Sub InitAges()
    dicAge.Add "ORSCH 3DAYOR REPORT", 60
    dicAge.Add "ORSCH 3DAYORGI REPORT", 60
    dicAge.Add "ORSCH 3DAYORSDC REPORT", 60
    dicAge.Add "ACTIVEDIETS REPORT", 120
    dicAge.Add "CLINICAL 1F MEDSURG", 120
    dicAge.Add "CLINICAL 2F DCU", 120
    dicAge.Add "CLINICAL 2F ICUCCU", 120
    dicAge.Add "CLINICAL 3F MEDSURG", 120
    dicAge.Add "CLINICAL 4F MEDSURG", 120
    dicAge.Add "CLINICAL 5F MEDSURG", 120
    dicAge.Add "CLINICAL CBH", 120
    dicAge.Add "CLINICAL L&DPPNICU", 120
    dicAge.Add "CLINICAL NTSICU", 120
    dicAge.Add "CLINICAL OVERFLOW", 120
    dicAge.Add "CLINICAL RIP", 120
    dicAge.Add "DIET NOURISHMENT REPORT", 120
    dicAge.Add "EMAR IVSS 1F MEDSURG", 120
    dicAge.Add "EMAR IVSS 2F DCU", 120
    dicAge.Add "EMAR IVSS 2F ICUCCU", 120
    dicAge.Add "EMAR IVSS 3F MEDSURG", 120
    dicAge.Add "EMAR IVSS 4F MEDSURG", 120
    dicAge.Add "EMAR IVSS 5FMEDSURG", 120
    dicAge.Add "EMAR IVSS CBH", 120
    dicAge.Add "EMAR IVSS L&DPPNICU", 120
    dicAge.Add "EMAR IVSS NTSICU", 120
    dicAge.Add "EMAR IVSS RIP", 120
    dicAge.Add "ICUERAND DCU", 120
    dicAge.Add "ICUERAND ICU", 120
    dicAge.Add "ICUERAND NTSICU", 120
    dicAge.Add "ICUERAND OVERFLOW", 120
    dicAge.Add "LABSUM 2F DCU", 120
    dicAge.Add "LABSUM 3FMEDSURG", 120
    dicAge.Add "LABSUM ALBUMINPREA", 120
    dicAge.Add "LABSUM CBH", 120
    dicAge.Add "LABSUM MN", 120
    dicAge.Add "LABSUM NTICU", 120
    dicAge.Add "LABSUM OVERFLOW", 120
    dicAge.Add "LABSUM RIP", 120
    dicAge.Add "LABSUM-2FICU&CCU", 120
    dicAge.Add "MAR CBH", 120
    dicAge.Add "MAR OVERFLOW", 120
    dicAge.Add "MAR RIP", 120
    dicAge.Add "MSERAND 3FLOOR", 120
    dicAge.Add "MSERAND 4FLOOR", 120
    dicAge.Add "MSERAND 5FLOOR", 120
    dicAge.Add "MSERAND OVERFLOW", 120
    dicAge.Add "MSERAND RIP", 120
    dicAge.Add "PATIENTSNAPSHOT 1F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 2F DCU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 2F ICUCCU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 3F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 4F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 5F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT CBH REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT L&DPPNICU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT NTSICU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT RIP REPORT", 120
    dicAge.Add "POM 1F MEDSURG", 120
    dicAge.Add "POM 2F DCU", 120
    dicAge.Add "POM 2F ICUCCU", 120
    dicAge.Add "POM 3F MEDSURG", 120
    dicAge.Add "POM 4F MedSurg", 120
    dicAge.Add "POM 5F MEDSURG", 120
    dicAge.Add "POM CBH", 120
    dicAge.Add "POM L&DPPNICU", 120
    dicAge.Add "POM NTSICU", 120
    dicAge.Add "POM OVERFLOW", 120
    dicAge.Add "POM RIP", 120
    dicAge.Add "MAR 1F A40", 180
    dicAge.Add "MAR 2F ICUCCU", 180
    dicAge.Add "MAR 2FDCU", 180
    dicAge.Add "MAR 3F MEDSURG", 180
    dicAge.Add "MAR 4F MEDSURG", 180
    dicAge.Add "MAR 5F MedSurg", 180
    dicAge.Add "MAR L&DPPNICU", 180
    dicAge.Add "MAR NTSICU", 180
    dicAge.Add "ADM CBHOB", 720
    dicAge.Add "ADM INPTAUTH", 720
    dicAge.Add "ADM PREREG", 720
    dicAge.Add "CAREPLAN 2FECDCU", 1440
    dicAge.Add "CAREPLAN 2FEDICU", 1440
    dicAge.Add "CAREPLAN 2FMNADCU", 1440
    dicAge.Add "CAREPLAN 2FMSADCU", 1440
    dicAge.Add "CAREPLAN 2FWCDCU", 1440
    dicAge.Add "CAREPLAN 2MSBICU", 1440
    dicAge.Add "CAREPLAN 3 FECSURG", 1440
    dicAge.Add "CAREPLAN 3 FWCSURG", 1440
    dicAge.Add "CAREPLAN 3 MNASURG", 1440
    dicAge.Add "CAREPLAN 3 MSAMSURG", 1440
    dicAge.Add "CAREPLAN 3 MSASURG", 1440
    dicAge.Add "CAREPLAN 4 FEAONC", 1440
    dicAge.Add "CAREPLAN 4 FEBONC", 1440
    dicAge.Add "CAREPLAN 4 FWONC", 1440
    dicAge.Add "CAREPLAN 5 MNA NEURO", 1440
    dicAge.Add "CAREPLAN 5 MSBNEURO", 1440
    dicAge.Add "CAREPLAN CBH", 1440
    dicAge.Add "CAREPLAN E1F1", 1440
    dicAge.Add "CAREPLAN E1F2", 1440
    dicAge.Add "CAREPLAN EAHA", 1440
    dicAge.Add "CAREPLAN RIP", 1440
    dicAge.Add "SCH CARD REPORT", 1440
    dicAge.Add "SCH CCLPHYS REPORT", 1440
    dicAge.Add "SCH COTC REPORT", 1440
    dicAge.Add "SCH ECHCNPS REPORT", 1440
    dicAge.Add "SCH ECHCPEDMDS REPORT", 1440
    dicAge.Add "SCH ECHCSOCWKR REPORT", 1440
    dicAge.Add "SCH EEG REPORTS", 1440
    dicAge.Add "SCH FADEPT REPORT", 1440
    dicAge.Add "SCH FHEM REPORT", 1440
    dicAge.Add "SCH HBOC REPORT", 1440
    dicAge.Add "SCH ITDEPT REPORT", 1440
    dicAge.Add "SCH LMFC REPORT", 1440
    dicAge.Add "SCH OPAIDE REPORT", 1440
    dicAge.Add "SCH OPALL REPORT", 1440
    dicAge.Add "SCH PATRNS REPORT", 1440
    dicAge.Add "SCH PATROOMS REPORT", 1440
    dicAge.Add "SCH WOS REPORT", 1440
End Sub

Open in new window

~bp
0
williamss132Author Commented:
When I run this, I receive error: Expected end of Statement: Line: 40 Char: 107
0
Bill PrewCommented:
Sorry, small typo, omitted an "&".  That line should be:

Wscript.Echo "Checking file: " & objFile.Path & "," & objFSO.GetExtensionName(objFile.Path) & "," & objFSO.GetBaseName(objFile.Path)

Open in new window

~bp
0
williamss132Author Commented:
OK.  So this checks each file and pops up a message to click ok.  Scanning... Checking file...

I didn't receive an email.  What's the purpose of the new code?
0
Bill PrewCommented:
Please run the script from a command line as follows and post up the output file.

cscript myscript.vbs > log.txt

Open in new window

The new logic is purely to help me debug the problem and see what the code is doing.

~bp
0
williamss132Author Commented:
0
Bill PrewCommented:
Okay, I see the problem now.  The table that we match against doesn't have .PDF on the end of each file name, while the filenames do, as well as the actual extension of .ENC.

So you can either just add .PDF to the end of each file name in the table load area, like:

    dicAge.Add "ORSCH 3DAYOR REPORT.PDF", 60
    dicAge.Add "ORSCH 3DAYORGI REPORT.PDF", 60
    dicAge.Add "ORSCH 3DAYORSDC REPORT.PDF", 60

Open in new window

The other approach is that if EVERY file you want to process will always end in .PDF.ENC then we could remove the .PDF before looking up on the dictionary.

Any preference?

~bp
0
williamss132Author Commented:
Yes, as I stated above (2013-10-10 at 11:06:16), all of the files will always have .pdf.enc on the end.  I like the 2nd approach here.  Please show me how to do that.  

Thanks for your help on this bp
0
Bill PrewCommented:
Okay, here's a version that should remove the extra ".pdf".  I also added a "switch" at the top that can turn the extra debugging displays we added on or off.  It's off right now, so give it a try as it is and see if you get an email.  If you don't then set the switch to True and run again with the CSCRIPT command and creating the log file as we did above, and post that back here please.

' This script processes the list of files in the directory’s subfolders (i.e. recursively)  passed as argument
' and returns 1 if any file is older than "age_threshold" minutes

' Set this switch to True to display logging throughout the process for debugging
blnDebug = False

' Define the folder to scan, and the extension of files to check
strBaseDir = "C:\Summit\Test\"
strBaseExt = "enc"

' Create a file system object for use in the script
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Create dictionary object to store file name / age pairs
' (set for case insensitive key matching)
Set dicAge = CreateObject("Scripting.Dictionary")
dicAge.CompareMode = vbTextCompare

' Call routine to load key / value pairs into dictionary
' These will specify the age to keep for each file name
InitAges()

' Initialize results variables for recursive scan
intFoundCount = 0
strFoundList = ""

' Recursively scan from the base folder looking for matches
ScanFolder(objFSO.GetFolder(strBaseDir))

' If any files found then send email with results
If intFoundCount > 0 Then
    If blnDebug Then Wscript.Echo intFoundCount
    If blnDebug Then Wscript.Echo strFoundList
    SendMail
End If

' Recursive subroutine to look for "old" files in a folder
Sub ScanFolder(objFolder)
    If blnDebug Then Wscript.Echo "Scanning folder: " & objFolder.Path

    ' Check each file in the folder
    For Each objFile in objFolder.Files
        If blnDebug Then Wscript.Echo "Checking file: " & objFile.Path & "," & objFSO.GetExtensionName(objFile.Path) & "," objFSO.GetBaseName(objFile.Path)
        ' Make sure it matches the extension we want
        If LCase(objFSO.GetExtensionName(objFile.Path)) = LCase(strBaseExt) Then
            If blnDebug Then Wscript.Echo "Matched base ext"
            ' Get the base name (no extension) and see if it's in the dictionary
            strBaseName = Replace(objFSO.GetBaseName(objFile.Path), ".pdf", "", 1, -1, vbTextCompare)
            If dicAge.Exists(strBaseName) Then
                If blnDebug Then Wscript.Echo "Found in dict, " & DateDiff("n", objFile.DateLastModified, Now) > dicAge.Item(strBaseName)
                ' Check if its age exceeds the threshold for this file
                If DateDiff("n", objFile.DateLastModified, Now) > dicAge.Item(strBaseName) Then
                    If blnDebug Then Wscript.Echo "Matched date diff"
                    ' Add to list of "old" files
                    intFoundCount = intFoundCount + 1
                    strFoundList = strFoundList & vbCrLf & objFile.Path & vbCrLf
                End If
            End If
        End If
    Next

    ' Recursive logic to drill down into all subfolders of this folder
    For Each objSubFolder In objFolder.SubFolders
        ScanFolder(objSubFolder)
    Next
End Sub

' Subountine to email with search results
Sub Sendmail()
      Set objMessage = CreateObject("CDO.Message")

      'Send Message
      strToEmailAddress = "me@mydomain.com"
      strFromEmailAddress = "me@mydomain.com"
      strSMTPServer = "mydomain.com"
      strSMTPServerPort = 25
      
      objMessage.Subject = "Old file(s) found!"
      objMessage.From = "Old file scanner <" & strFromEmailAddress & ">"""
      objMessage.To = strToEmailAddress
      objMessage.TextBody = "Old file found: " & strFoundList & chr(32) & FormatDateTime(file.DateLastModified,0)
      objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
      objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer
      objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = strSMTPServerPort
      objMessage.Configuration.Fields.Update
      objMessage.Send
End Sub 

' Subroutine to initialize the ages dictionary
Sub InitAges()
    dicAge.Add "ORSCH 3DAYOR REPORT", 60
    dicAge.Add "ORSCH 3DAYORGI REPORT", 60
    dicAge.Add "ORSCH 3DAYORSDC REPORT", 60
    dicAge.Add "ACTIVEDIETS REPORT", 120
    dicAge.Add "CLINICAL 1F MEDSURG", 120
    dicAge.Add "CLINICAL 2F DCU", 120
    dicAge.Add "CLINICAL 2F ICUCCU", 120
    dicAge.Add "CLINICAL 3F MEDSURG", 120
    dicAge.Add "CLINICAL 4F MEDSURG", 120
    dicAge.Add "CLINICAL 5F MEDSURG", 120
    dicAge.Add "CLINICAL CBH", 120
    dicAge.Add "CLINICAL L&DPPNICU", 120
    dicAge.Add "CLINICAL NTSICU", 120
    dicAge.Add "CLINICAL OVERFLOW", 120
    dicAge.Add "CLINICAL RIP", 120
    dicAge.Add "DIET NOURISHMENT REPORT", 120
    dicAge.Add "EMAR IVSS 1F MEDSURG", 120
    dicAge.Add "EMAR IVSS 2F DCU", 120
    dicAge.Add "EMAR IVSS 2F ICUCCU", 120
    dicAge.Add "EMAR IVSS 3F MEDSURG", 120
    dicAge.Add "EMAR IVSS 4F MEDSURG", 120
    dicAge.Add "EMAR IVSS 5FMEDSURG", 120
    dicAge.Add "EMAR IVSS CBH", 120
    dicAge.Add "EMAR IVSS L&DPPNICU", 120
    dicAge.Add "EMAR IVSS NTSICU", 120
    dicAge.Add "EMAR IVSS RIP", 120
    dicAge.Add "ICUERAND DCU", 120
    dicAge.Add "ICUERAND ICU", 120
    dicAge.Add "ICUERAND NTSICU", 120
    dicAge.Add "ICUERAND OVERFLOW", 120
    dicAge.Add "LABSUM 2F DCU", 120
    dicAge.Add "LABSUM 3FMEDSURG", 120
    dicAge.Add "LABSUM ALBUMINPREA", 120
    dicAge.Add "LABSUM CBH", 120
    dicAge.Add "LABSUM MN", 120
    dicAge.Add "LABSUM NTICU", 120
    dicAge.Add "LABSUM OVERFLOW", 120
    dicAge.Add "LABSUM RIP", 120
    dicAge.Add "LABSUM-2FICU&CCU", 120
    dicAge.Add "MAR CBH", 120
    dicAge.Add "MAR OVERFLOW", 120
    dicAge.Add "MAR RIP", 120
    dicAge.Add "MSERAND 3FLOOR", 120
    dicAge.Add "MSERAND 4FLOOR", 120
    dicAge.Add "MSERAND 5FLOOR", 120
    dicAge.Add "MSERAND OVERFLOW", 120
    dicAge.Add "MSERAND RIP", 120
    dicAge.Add "PATIENTSNAPSHOT 1F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 2F DCU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 2F ICUCCU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 3F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 4F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 5F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT CBH REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT L&DPPNICU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT NTSICU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT RIP REPORT", 120
    dicAge.Add "POM 1F MEDSURG", 120
    dicAge.Add "POM 2F DCU", 120
    dicAge.Add "POM 2F ICUCCU", 120
    dicAge.Add "POM 3F MEDSURG", 120
    dicAge.Add "POM 4F MedSurg", 120
    dicAge.Add "POM 5F MEDSURG", 120
    dicAge.Add "POM CBH", 120
    dicAge.Add "POM L&DPPNICU", 120
    dicAge.Add "POM NTSICU", 120
    dicAge.Add "POM OVERFLOW", 120
    dicAge.Add "POM RIP", 120
    dicAge.Add "MAR 1F A40", 180
    dicAge.Add "MAR 2F ICUCCU", 180
    dicAge.Add "MAR 2FDCU", 180
    dicAge.Add "MAR 3F MEDSURG", 180
    dicAge.Add "MAR 4F MEDSURG", 180
    dicAge.Add "MAR 5F MedSurg", 180
    dicAge.Add "MAR L&DPPNICU", 180
    dicAge.Add "MAR NTSICU", 180
    dicAge.Add "ADM CBHOB", 720
    dicAge.Add "ADM INPTAUTH", 720
    dicAge.Add "ADM PREREG", 720
    dicAge.Add "CAREPLAN 2FECDCU", 1440
    dicAge.Add "CAREPLAN 2FEDICU", 1440
    dicAge.Add "CAREPLAN 2FMNADCU", 1440
    dicAge.Add "CAREPLAN 2FMSADCU", 1440
    dicAge.Add "CAREPLAN 2FWCDCU", 1440
    dicAge.Add "CAREPLAN 2MSBICU", 1440
    dicAge.Add "CAREPLAN 3 FECSURG", 1440
    dicAge.Add "CAREPLAN 3 FWCSURG", 1440
    dicAge.Add "CAREPLAN 3 MNASURG", 1440
    dicAge.Add "CAREPLAN 3 MSAMSURG", 1440
    dicAge.Add "CAREPLAN 3 MSASURG", 1440
    dicAge.Add "CAREPLAN 4 FEAONC", 1440
    dicAge.Add "CAREPLAN 4 FEBONC", 1440
    dicAge.Add "CAREPLAN 4 FWONC", 1440
    dicAge.Add "CAREPLAN 5 MNA NEURO", 1440
    dicAge.Add "CAREPLAN 5 MSBNEURO", 1440
    dicAge.Add "CAREPLAN CBH", 1440
    dicAge.Add "CAREPLAN E1F1", 1440
    dicAge.Add "CAREPLAN E1F2", 1440
    dicAge.Add "CAREPLAN EAHA", 1440
    dicAge.Add "CAREPLAN RIP", 1440
    dicAge.Add "SCH CARD REPORT", 1440
    dicAge.Add "SCH CCLPHYS REPORT", 1440
    dicAge.Add "SCH COTC REPORT", 1440
    dicAge.Add "SCH ECHCNPS REPORT", 1440
    dicAge.Add "SCH ECHCPEDMDS REPORT", 1440
    dicAge.Add "SCH ECHCSOCWKR REPORT", 1440
    dicAge.Add "SCH EEG REPORTS", 1440
    dicAge.Add "SCH FADEPT REPORT", 1440
    dicAge.Add "SCH FHEM REPORT", 1440
    dicAge.Add "SCH HBOC REPORT", 1440
    dicAge.Add "SCH ITDEPT REPORT", 1440
    dicAge.Add "SCH LMFC REPORT", 1440
    dicAge.Add "SCH OPAIDE REPORT", 1440
    dicAge.Add "SCH OPALL REPORT", 1440
    dicAge.Add "SCH PATRNS REPORT", 1440
    dicAge.Add "SCH PATROOMS REPORT", 1440
    dicAge.Add "SCH WOS REPORT", 1440
End Sub

Open in new window

~bp
0
williamss132Author Commented:
I got it working except for this line.

objMessage.TextBody = "Old file found: " & strFoundList '& vbCrlf & FormatDateTime(objFile.DateLastModified,0)

It doesn't know what objFile.DateLastModified is.  When I change it to only show the strFoundList it works.  How can I add the DateLastModified?  

When I run it I get error: Object required 'objFile'
It's defined above.  Why doesn't it recognize the use above?  
Is it because it needs to be redefined after the End Sub??
0
Bill PrewCommented:
Sorry, that looks like a pre-existing problem with your prior logic.

So in the email you can have a list of files, right? So, do you want the lastmodifieddate of each of the files in the list?  It doesn't look like that would have been happening before, but we can add that to the new version pretty easily if that's what you are wanting.

~bp
0
Bill PrewCommented:
Here's an update that adds the date to each file found.

' This script processes the list of files in the directory’s subfolders (i.e. recursively)  passed as argument
' and returns 1 if any file is older than "age_threshold" minutes

' Set this switch to True to display logging throughout the process for debugging
blnDebug = False

' Define the folder to scan, and the extension of files to check
strBaseDir = "C:\Summit\Test\"
strBaseExt = "enc"

' Create a file system object for use in the script
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Create dictionary object to store file name / age pairs
' (set for case insensitive key matching)
Set dicAge = CreateObject("Scripting.Dictionary")
dicAge.CompareMode = vbTextCompare

' Call routine to load key / value pairs into dictionary
' These will specify the age to keep for each file name
InitAges()

' Initialize results variables for recursive scan
intFoundCount = 0
strFoundList = ""

' Recursively scan from the base folder looking for matches
ScanFolder(objFSO.GetFolder(strBaseDir))

' If any files found then send email with results
If intFoundCount > 0 Then
    If blnDebug Then Wscript.Echo intFoundCount
    If blnDebug Then Wscript.Echo strFoundList
    SendMail
End If

' Recursive subroutine to look for "old" files in a folder
Sub ScanFolder(objFolder)
    If blnDebug Then Wscript.Echo "Scanning folder: " & objFolder.Path

    ' Check each file in the folder
    For Each objFile in objFolder.Files
        If blnDebug Then Wscript.Echo "Checking file: " & objFile.Path & "," & objFSO.GetExtensionName(objFile.Path) & "," objFSO.GetBaseName(objFile.Path)
        ' Make sure it matches the extension we want
        If LCase(objFSO.GetExtensionName(objFile.Path)) = LCase(strBaseExt) Then
            If blnDebug Then Wscript.Echo "Matched base ext"
            ' Get the base name (no extension) and see if it's in the dictionary
            strBaseName = Replace(objFSO.GetBaseName(objFile.Path), ".pdf", "", 1, -1, vbTextCompare)
            If dicAge.Exists(strBaseName) Then
                If blnDebug Then Wscript.Echo "Found in dict, " & DateDiff("n", objFile.DateLastModified, Now) > dicAge.Item(strBaseName)
                ' Check if its age exceeds the threshold for this file
                If DateDiff("n", objFile.DateLastModified, Now) > dicAge.Item(strBaseName) Then
                    If blnDebug Then Wscript.Echo "Matched date diff"
                    ' Add to list of "old" files
                    intFoundCount = intFoundCount + 1
                    strFoundList = strFoundList & vbCrLf & objFile.Path & " - " & FormatDateTime(file.DateLastModified, 0) & vbCrLf
                End If
            End If
        End If
    Next

    ' Recursive logic to drill down into all subfolders of this folder
    For Each objSubFolder In objFolder.SubFolders
        ScanFolder(objSubFolder)
    Next
End Sub

' Subountine to email with search results
Sub Sendmail()
      Set objMessage = CreateObject("CDO.Message")

      'Send Message
      strToEmailAddress = "me@mydomain.com"
      strFromEmailAddress = "me@mydomain.com"
      strSMTPServer = "mydomain.com"
      strSMTPServerPort = 25
      
      objMessage.Subject = "Old file(s) found!"
      objMessage.From = "Old file scanner <" & strFromEmailAddress & ">"""
      objMessage.To = strToEmailAddress
      objMessage.TextBody = "Old files found: " & strFoundList
      objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
      objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer
      objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = strSMTPServerPort
      objMessage.Configuration.Fields.Update
      objMessage.Send
End Sub 

' Subroutine to initialize the ages dictionary
Sub InitAges()
    dicAge.Add "ORSCH 3DAYOR REPORT", 60
    dicAge.Add "ORSCH 3DAYORGI REPORT", 60
    dicAge.Add "ORSCH 3DAYORSDC REPORT", 60
    dicAge.Add "ACTIVEDIETS REPORT", 120
    dicAge.Add "CLINICAL 1F MEDSURG", 120
    dicAge.Add "CLINICAL 2F DCU", 120
    dicAge.Add "CLINICAL 2F ICUCCU", 120
    dicAge.Add "CLINICAL 3F MEDSURG", 120
    dicAge.Add "CLINICAL 4F MEDSURG", 120
    dicAge.Add "CLINICAL 5F MEDSURG", 120
    dicAge.Add "CLINICAL CBH", 120
    dicAge.Add "CLINICAL L&DPPNICU", 120
    dicAge.Add "CLINICAL NTSICU", 120
    dicAge.Add "CLINICAL OVERFLOW", 120
    dicAge.Add "CLINICAL RIP", 120
    dicAge.Add "DIET NOURISHMENT REPORT", 120
    dicAge.Add "EMAR IVSS 1F MEDSURG", 120
    dicAge.Add "EMAR IVSS 2F DCU", 120
    dicAge.Add "EMAR IVSS 2F ICUCCU", 120
    dicAge.Add "EMAR IVSS 3F MEDSURG", 120
    dicAge.Add "EMAR IVSS 4F MEDSURG", 120
    dicAge.Add "EMAR IVSS 5FMEDSURG", 120
    dicAge.Add "EMAR IVSS CBH", 120
    dicAge.Add "EMAR IVSS L&DPPNICU", 120
    dicAge.Add "EMAR IVSS NTSICU", 120
    dicAge.Add "EMAR IVSS RIP", 120
    dicAge.Add "ICUERAND DCU", 120
    dicAge.Add "ICUERAND ICU", 120
    dicAge.Add "ICUERAND NTSICU", 120
    dicAge.Add "ICUERAND OVERFLOW", 120
    dicAge.Add "LABSUM 2F DCU", 120
    dicAge.Add "LABSUM 3FMEDSURG", 120
    dicAge.Add "LABSUM ALBUMINPREA", 120
    dicAge.Add "LABSUM CBH", 120
    dicAge.Add "LABSUM MN", 120
    dicAge.Add "LABSUM NTICU", 120
    dicAge.Add "LABSUM OVERFLOW", 120
    dicAge.Add "LABSUM RIP", 120
    dicAge.Add "LABSUM-2FICU&CCU", 120
    dicAge.Add "MAR CBH", 120
    dicAge.Add "MAR OVERFLOW", 120
    dicAge.Add "MAR RIP", 120
    dicAge.Add "MSERAND 3FLOOR", 120
    dicAge.Add "MSERAND 4FLOOR", 120
    dicAge.Add "MSERAND 5FLOOR", 120
    dicAge.Add "MSERAND OVERFLOW", 120
    dicAge.Add "MSERAND RIP", 120
    dicAge.Add "PATIENTSNAPSHOT 1F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 2F DCU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 2F ICUCCU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 3F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 4F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT 5F MEDSURG REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT CBH REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT L&DPPNICU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT NTSICU REPORT", 120
    dicAge.Add "PATIENTSNAPSHOT RIP REPORT", 120
    dicAge.Add "POM 1F MEDSURG", 120
    dicAge.Add "POM 2F DCU", 120
    dicAge.Add "POM 2F ICUCCU", 120
    dicAge.Add "POM 3F MEDSURG", 120
    dicAge.Add "POM 4F MedSurg", 120
    dicAge.Add "POM 5F MEDSURG", 120
    dicAge.Add "POM CBH", 120
    dicAge.Add "POM L&DPPNICU", 120
    dicAge.Add "POM NTSICU", 120
    dicAge.Add "POM OVERFLOW", 120
    dicAge.Add "POM RIP", 120
    dicAge.Add "MAR 1F A40", 180
    dicAge.Add "MAR 2F ICUCCU", 180
    dicAge.Add "MAR 2FDCU", 180
    dicAge.Add "MAR 3F MEDSURG", 180
    dicAge.Add "MAR 4F MEDSURG", 180
    dicAge.Add "MAR 5F MedSurg", 180
    dicAge.Add "MAR L&DPPNICU", 180
    dicAge.Add "MAR NTSICU", 180
    dicAge.Add "ADM CBHOB", 720
    dicAge.Add "ADM INPTAUTH", 720
    dicAge.Add "ADM PREREG", 720
    dicAge.Add "CAREPLAN 2FECDCU", 1440
    dicAge.Add "CAREPLAN 2FEDICU", 1440
    dicAge.Add "CAREPLAN 2FMNADCU", 1440
    dicAge.Add "CAREPLAN 2FMSADCU", 1440
    dicAge.Add "CAREPLAN 2FWCDCU", 1440
    dicAge.Add "CAREPLAN 2MSBICU", 1440
    dicAge.Add "CAREPLAN 3 FECSURG", 1440
    dicAge.Add "CAREPLAN 3 FWCSURG", 1440
    dicAge.Add "CAREPLAN 3 MNASURG", 1440
    dicAge.Add "CAREPLAN 3 MSAMSURG", 1440
    dicAge.Add "CAREPLAN 3 MSASURG", 1440
    dicAge.Add "CAREPLAN 4 FEAONC", 1440
    dicAge.Add "CAREPLAN 4 FEBONC", 1440
    dicAge.Add "CAREPLAN 4 FWONC", 1440
    dicAge.Add "CAREPLAN 5 MNA NEURO", 1440
    dicAge.Add "CAREPLAN 5 MSBNEURO", 1440
    dicAge.Add "CAREPLAN CBH", 1440
    dicAge.Add "CAREPLAN E1F1", 1440
    dicAge.Add "CAREPLAN E1F2", 1440
    dicAge.Add "CAREPLAN EAHA", 1440
    dicAge.Add "CAREPLAN RIP", 1440
    dicAge.Add "SCH CARD REPORT", 1440
    dicAge.Add "SCH CCLPHYS REPORT", 1440
    dicAge.Add "SCH COTC REPORT", 1440
    dicAge.Add "SCH ECHCNPS REPORT", 1440
    dicAge.Add "SCH ECHCPEDMDS REPORT", 1440
    dicAge.Add "SCH ECHCSOCWKR REPORT", 1440
    dicAge.Add "SCH EEG REPORTS", 1440
    dicAge.Add "SCH FADEPT REPORT", 1440
    dicAge.Add "SCH FHEM REPORT", 1440
    dicAge.Add "SCH HBOC REPORT", 1440
    dicAge.Add "SCH ITDEPT REPORT", 1440
    dicAge.Add "SCH LMFC REPORT", 1440
    dicAge.Add "SCH OPAIDE REPORT", 1440
    dicAge.Add "SCH OPALL REPORT", 1440
    dicAge.Add "SCH PATRNS REPORT", 1440
    dicAge.Add "SCH PATROOMS REPORT", 1440
    dicAge.Add "SCH WOS REPORT", 1440
End Sub

Open in new window

~bp
0
williamss132Author Commented:
I get the same error.
0
Bill PrewCommented:
Sorry, cut and paste error when I moved your code.  Change:

strFoundList = strFoundList & vbCrLf & objFile.Path & " - " & FormatDateTime(file.DateLastModified, 0) & vbCrLf

Open in new window

to:

strFoundList = strFoundList & vbCrLf & objFile.Path & " - " & FormatDateTime(objFile.DateLastModified, 0) & vbCrLf

Open in new window

~bp
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
williamss132Author Commented:
Thanks bp.  Works great!
0
Bill PrewCommented:
Welcome.

~bp
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.