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

Posted on 2007-04-02
Last Modified: 2010-08-05

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.
Question by:BarryTice
  • 4
  • 3
  • 2
LVL 67

Assisted Solution

sirbounty earned 50 total points
ID: 18836759
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:\"

Author Comment

ID: 18837023
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?
LVL 67

Expert Comment

ID: 18837039
Still looking over the script...
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

LVL 70

Expert Comment

by:Chris Dent
ID: 18837159

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.


Author Comment

ID: 18837531
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).

Author Comment

ID: 18838934
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.
LVL 70

Accepted Solution

Chris Dent earned 200 total points
ID: 18841661

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.


Author Comment

ID: 18860188

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!
LVL 70

Expert Comment

by:Chris Dent
ID: 18861201

Excellent news. Glad you have it working :)


Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Welcome back!  My apologies for taking so long to write part two of this series; it's been a long time coming!  As I promised in Part 1, this article will focus on how to locate those elusive AD properties that you are searching for.  Why is this us…
When it comes to writing scripts for a Client/Server computing environment it is essential to consider some way of enabling the authentication functionality within a script. This sort of consideration mainly comes into the picture when we are dealin…
Established in 1997, Technology Architects has become one of the most reputable technology solutions companies in the country. TA have been providing businesses with cost effective state-of-the-art solutions and unparalleled service that is designed…

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question