Solved

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

Posted on 2007-04-02
9
349 Views
Last Modified: 2010-08-05
Greetings.

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, filename.abc becomes filename_20070402_DA_20070502.abc.

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
Const EVENT_SUCCESS = 0
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
fileLog.Close

' 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
                      fFile.Delete
                  End If
              End If
          End If
    Next
    ' Recursively iterate through the SubFolders collection
    For Each fSubFolder In fFolder.SubFolders
          ' Wipe each subfolder (depth-first traversal)
        CleanDirectory fSubFolder.Path, fso, fileLog
    Next
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:
D:\Dir\Subdir\SubSubDir\SubSubSubDir\SubSubSubSubDir1\SSSSSDir\file_20060729_DA_20061115.abc

However, this file is still present on the system, and doesn't show up in the log file:
D:\Dir\Subdir\SubSubDir\SubSubSubDir\SubSubSubSubDir2\SSSSSDir\file_20060729_DA_20061115.abc

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?

Thanks.

-- b.r.t.
0
Comment
Question by:BarryTice
  • 4
  • 3
  • 2
9 Comments
 
LVL 67

Assisted Solution

by:sirbounty
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:\"
0
 
LVL 7

Author Comment

by:BarryTice
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\file_20060729_DA_20061115.abc, but not finding SubSubSubSubDir2\SSSSSDir\file_20060729_DA_20061115.abc (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?
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 18837039
Still looking over the script...
0
 
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.

Chris
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 7

Author Comment

by:BarryTice
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).
0
 
LVL 7

Author Comment

by:BarryTice
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.
0
 
LVL 70

Accepted Solution

by:
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.

Chris
0
 
LVL 7

Author Comment

by:BarryTice
ID: 18860188
Greetings.

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

Expert Comment

by:Chris Dent
ID: 18861201

Excellent news. Glad you have it working :)

Chris
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Recently I finished a vbscript that I thought I'd share.  It uses a text file with a list of server names to loop through and get various status reports, then writes them all into an Excel file.  Originally it was put together for our Altiris server…
Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I come…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

705 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now