File purge VB script -- Why is it skipping files?


I have a server on which I sometimes have to update files. When I update a file, I set aside a copy of the file in its current state with a date code in the filename. So, becomes

The first date is the date the file was replaced, and the second date is the date after which the file may be deleted (DA = Delete After).

I've created a VB script to search through my file system locating files where the second date has passed, indicating that the files may be deleted. It logs each file it finds and deletes, and it does find a majority of the files.

But I've found taht there are files being skipped, and I can't find any rhyme or reason for those that have been skipped.

Here is the script:
==== BEGIN PASTE ====
' Description  : This program deletes files from the server that have
'                filenames of the format:
'                {stuff}{Date}{Delimeter}DA{Delimeter}{Date}{Stuff}
'                For example: defects 20070314 DA 20070401.tds
'                Or:          defects_20070314-DA-20070401.tds
' strLogName indicates where the log file will be created.
' strpurgeDir tells which directory to plumb for files to delete.

strLogName = "D:\DA_Purge.log"
strPurgeDir = "D:"

' ============================================================================

dim fso, objShell, fileLog
On Error Resume Next

' Create objects to allow writing to the Windows Event Log
Set objShell = Wscript.CreateObject("Wscript.Shell")

' Write notification to the Windows Event Log
'objShell.LogEvent EVENT_SUCCESS, "Beginning purge of DA files."

' Create log file
set fso = CreateObject("Scripting.FileSystemObject")
Set fileLog = fso.OpenTextFile(strLogName, 8, True)

' Write log file header
fileLog.Write "Beginning purge of files with delete dates specified in "
fileLog.Write strPurgeDir & " at " & Time & " on " & Date & vbcrlf & vbcrlf

' Call the recursive process
CleanDirectory strPurgeDir, fso, fileLog

' Write log file closer
fileLog.Write vbcrlf & "Ending purge of files at " & Time & vbcrlf
fileLow.Write "============================================" & vbcrlf & vbcrlf

' Write notification to the Windows Event Log
'objShell.LogEvent EVENT_SUCCESS, "Ending purge of DA files. Look to " & _
'    strLogName & " for details."

Set fso = Nothing
Set objShell = Nothing
Set fileLog = Nothing

Sub CleanDirectory(strDirectory, fso, fileLog)
    dim fFolder
    Set fFolder = fso.GetFolder(strDirectory)
    For Each fFile In fFolder.Files
          If Instr(fFile.Name, "DA") > 10 Then
              ' This might be a Delete-After file
              If IsDAFile(fFile.Name) Then
                  strDate = Mid(fFile.Name, Instr(fFile.Name, "DA") + 3, 8)
                  ' Reformat date from 'YYYYMMDD' to 'MM/DD/YYYY'
                  strYear = Left(strDate, 4)
                  strMonth = Mid(strDate, 5, 2)
                  strDay = Right(strDate, 2)
                  strDate = strMonth & "/" & strDay & "/" & strYear
                  If DateDiff("d", strDate, Date) > 0 Then
                      ' Log and delete
                      fileLog.Write fFile.Path & vbcrlf
                  End If
              End If
          End If
    ' Recursively iterate through the SubFolders collection
    For Each fSubFolder In fFolder.SubFolders
          ' Wipe each subfolder (depth-first traversal)
        CleanDirectory fSubFolder.Path, fso, fileLog
End Sub

Function IsDAFile(strFileName)
    IsDAFile = False
    strRange = Mid(strFileName, instr(strFileName, "DA") - 10, 22)
    ' Verify that file name is long enough
    If Len(strRange) < 22 Then Exit Function
    ' Verify that range doesn't start with a number
    If IsNumeric(Left(strRange, 1)) Then Exit Function
    ' Verify next eight characters could be a date
    If Not IsNumeric(Mid(strRange, 2, 8)) Then Exit Function
    ' Verify that range does not end with a number
    If IsNumeric(Right(strRange, 1)) Then Exit Function
    ' Verify previous eight characters could be a date
    If Not IsNumeric(Mid(strRange, 14, 8)) Then Exit Function
    ' Look for underscore, space or dash before and after "DA"
    strChar = Mid(strRange, 10, 1)
    If strChar <> " " And strChar <> "_" And strChar <> "-" Then Exit Function
    strChar = Mid(strRange, 13, 1)
    If strChar <> " " And strChar <> "_" And strChar <> "-" Then Exit Function
    ' At this point, we know we have X########_DA_########X or something
    ' similar, where X is not numeric, # is numeric, and _ could be
    ' an underscore, space or hyphen
    IsDAFile = True
End Function
===== END PASTE =====

The log file shows that a file such as this one was found and removed, and checking the path verifies that it is no longer there:

However, this file is still present on the system, and doesn't show up in the log file:

If I change strPurgeDir to D:\Dir\Subdir\SubSubDir\SubSubSubDir\SubSubSubSubDir2, it finds the file and deletes it as expected. But somehow it's not finding SubSubSubSubDir2 in its recursive descent.

Any idea why not?


-- b.r.t.
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

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.

What if you change strPurgeDir to an actual path? (D: isn't a path - it's a drive - so that 'may' be part of the problem)...just a knee-jerk suggestion...

strPurgeDir = "D:\"
BarryTiceAuthor Commented:
I haven't tried that, sirbounty, but suspect it's not the issue because the script is actually finding some of the files six or seven directories deep. So, I know it's making it as far as D:\Dir\Subdir\SubSubDir\SubSubSubDir without any issue. But within SubSubSubDir, it's finding SubSubSubSubDir1\SSSSSDir\, but not finding SubSubSubSubDir2\SSSSSDir\ (similar file, same filename, parallel directory structure).

Now, SubSubSubDir contains 74 directories, so maybe somehow it's reaching some upper limit. But it seems odd to me that the fso wouldn't be able to see 74 subdirectories in fFolder.SubFolders.

I'll change it and run a test if you have some confidence that that's the problem, but it takes about four hours to search through the entire D:\ drive (100 GB drive, about 60% full of small files).

Any other thoughts?
Still looking over the script...
Why Diversity in Tech Matters

Kesha Williams, certified professional and software developer, explores the imbalance of diversity in the world of technology -- especially when it comes to hiring women. She showcases ways she's making a difference through the Colors of STEM program.

Chris DentPowerShell DeveloperCommented:

I'd add a line in so you can see what happens when it performs the comparison:

strDate = strMonth & "/" & strDay & "/" & strYear
fileLog.Write fFile.Path & " " & strDate & " Date Dif: "  & DateDiff("d", strDate, Date)
If DateDiff("d", strDate, Date) > 0 Then

At least it gives you a start, if the file isn't listed then you can investigate why it's not getting pulled by the CleanDirectory subroutine.

BarryTiceAuthor Commented:
Good thought, Chris (any relation to Arthur?). But in this case, the file that is being skipped has the same date code (in fact, the same actual filename) as a number of files that are being deleted. It's just located in a different directory (though, a directory that is parallel in depth and in naming to the directories of other files that are being removed).
BarryTiceAuthor Commented:
For what it's worth, the script appears to stop after the 28th subdirectory in the D:\Dir\Subdir\SubSubDir\SubSubSubDir directory. SubSubSubDir contains 75 folders, and going alphabetically, (which it appears to do, from the contents of the log file) it appears to have stopped after the 28th subfolder. The 29th subfolder has a file that should have been removed and wasn't, as to other subfolders beyond the 29th.
Chris DentPowerShell DeveloperCommented:

It's not too important that it has the same name and date information, the line was really to see two things. First, if it was even getting to the file, and secondly what it used for comparison. I expect that it's simply not getting to the file at all, which, in turn, suggests it's abnormally terminating the Subroutine.

I suggest you remove this line:

On Error Resume Next

Then begin adding error control where it's needed. It's just that line makes things very difficult to troubleshoot. There are few errors in the File System object that can't be neatly worked around.


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
BarryTiceAuthor Commented:

I've determined the trouble on this script.

Apparently the On Error Resume Next only works within the scope in which it's defined (which is perfectly reasonable, when you get right down to it). So what is happening is, the script at some point was finding an "impossible" file (a directory had been moved into place from a shorter path into a longer path, and the resulting full file path was more than 256 characters). That casued it to error, which in the absence of an on error statement in the CleanDirectory subroutine was causing the error/exception to be passed up to the calling routine, which more often than not was itself (through recursive calls). That meant that routine would pass the error up until it got all the way out to the root, at which point it would nicely close the text file and call it a day.

I've corrected this by moving the On Error line into the beginning of the CleanDirectory subroutine. Now when it bombs on a file, it continues with the next file or subdirectory without issue.

Thanks for your help in pointing me in the right direction!
Chris DentPowerShell DeveloperCommented:

Excellent news. Glad you have it working :)

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.