Delete selected files while parsing a folder

[Robie]

Hi

I have written VBA code to delete specific files while parsing a folder. It works fine except after deletion. The deletion function uses a kill function (which also in the code below).
After deleting the first file, the Dir function *doesn't* return any more files to process. I know there are lots of files to delete yet.

Is there anyway I can fix this please? Thanks.

The code is as follows:

Code: Select all

Sub DeletePreviousDocuments(OldPath As String, StrFile As String)
'
'   DeletePreviousDocuments Macro
'   Deletes previous version files (except immediate previous) from Library after new documents are copied
'
    Dim LoopFile As String
    Dim sFNameNoExtension As String
    Dim sFileFromDirSearch As String
    Dim sSplitStr() As String

    Dim p As Long
    
    p = InStrRev(StrFile, ".")
    sFNameNoExtension = Mid(StrFile, 1, (p - 1))
    
    LoopFile = Dir(OldPath & "\*.*")
    Do While LoopFile <> ""
        p = InStrRev(LoopFile, ".")
        sFileFromDirSearch = Mid(LoopFile, 1, (p - 1))
        If (LCase(sFileFromDirSearch) <> LCase(sFNameNoExtension)) Then
            ' --------------------------------------------------------------------------
            ' Now delete this document 
            MsgBox (sFileFromDirSearch)
            DeleteFileProperly (OldPath & "\" & LoopFile)
        End If
        LoopFile = Dir
    Loop
End Sub

Public Function DeleteFileProperly(file2delete As String)
'
'   DeleteFileProperly Function
'   Make sure that the specified file is deleted
'
    On Error Resume Next
    If FileExists(file2delete) Then         ' If the file exists:
        SetAttr file2delete, vbNormal       ' Set its attribute to Normal
        Kill file2delete                    ' Delete it
    End If
End Function

[HansV]

The problem is that deleting a file disrupts the loop - you're pulling the rug out from under the loop's feet as it were. One workaround is not to delete the files immediately, but to add them to a list; once the loop is complete, delete the listed files:

Code: Select all

Sub DeletePreviousDocuments(OldPath As String, StrFile As String)
'
'   DeletePreviousDocuments Macro
'   Deletes previous version files (except immediate previous) from Library after new documents are copied
'
    Dim LoopFile As String
    Dim sFNameNoExtension As String
    Dim sFileFromDirSearch As String
    Dim sSplitStr() As String
    Dim cFiles As New Collection
    Dim itm As Variant
    Dim p As Long

    p = InStrRev(StrFile, ".")
    sFNameNoExtension = LCase(Left(StrFile, p - 1))

    LoopFile = Dir(OldPath & "\*.*")
    Do While LoopFile <> ""
        p = InStrRev(LoopFile, ".")
        sFileFromDirSearch = Left(LoopFile, p - 1)
        If LCase(sFileFromDirSearch) <> sFNameNoExtension Then
            ' --------------------------------------------------------------------------
            MsgBox sFileFromDirSearch
            ' Add file to collection
            cFiles.Add LoopFile, LoopFile
        End If
        LoopFile = Dir
    Loop

    ' Now delete the files
    For Each itm In cFiles
        DeleteFileProperly OldPath & "\" & itm
    Next itm
End Sub

[Robie]

The problem is that deleting a file disrupts the loop - you're pulling the rug out from under the loop's feet as it were. One workaround is not to delete the files immediately, but to add them to a list; once the loop is complete, delete the listed files:

Code: Select all

Sub DeletePreviousDocuments(OldPath As String, StrFile As String)
'
'   DeletePreviousDocuments Macro
'   Deletes previous version files (except immediate previous) from Library after new documents are copied
'
    Dim LoopFile As String
    Dim sFNameNoExtension As String
    Dim sFileFromDirSearch As String
    Dim sSplitStr() As String
    Dim cFiles As New Collection
    Dim itm As Variant
    Dim p As Long

    p = InStrRev(StrFile, ".")
    sFNameNoExtension = LCase(Left(StrFile, p - 1))

    LoopFile = Dir(OldPath & "\*.*")
    Do While LoopFile <> ""
        p = InStrRev(LoopFile, ".")
        sFileFromDirSearch = Left(LoopFile, p - 1)
        If LCase(sFileFromDirSearch) <> sFNameNoExtension Then
            ' --------------------------------------------------------------------------
            MsgBox sFileFromDirSearch
            ' Add file to collection
            cFiles.Add LoopFile, LoopFile
        End If
        LoopFile = Dir
    Loop

    ' Now delete the files
    For Each itm In cFiles
        DeleteFileProperly OldPath & "\" & itm
    Next itm
End Sub

Doh! Of course. Should have known that. :(
Thanks Hans.