Вложено Для каждого внутри До в VBA

Question

Мой скрипт vba здесь извлекает имена файлов из указанной папки в переменной: path и пытается их отсортировать, выделяя самые последние файлы.

Файлы отформатированы следующим образом: folderpath\filename[issue].extension с проблемой, которую мы используем, чтобы определить, насколько актуальна эта часть. В настоящее время я хочу, чтобы мой скрипт выполнял разделение имени файла и выдачу на две отдельные переменные, проверяя MyCollection, существует ли уже имя файла и, если оно существует, является ли оно наиболее актуальной проблемой. Конечная цель сценария - перебрать большую папку этих файлов и оставить только те, которые имеют наибольшую проблему

В настоящее время мой скрипт имеет вложенную For Each i in MyCollection, работающую внутри Do While Len(Filename) > 0. Когда я удаляю вложенную часть, она перебирает все файлы в папке, но когда она включена, она перебирает только две. Какова причина этого? Я не могу понять это

Проигнорируйте большинство msgbox, они просто я пытаюсь выяснить, какие коды до

Private Function PullUpdatedFileNames(Path As String) As Collection

Dim MyCollection As New Collection
Dim Filename As String
Dim TotalFiles As Integer

Dim PartName As String
Dim Issue As String

Dim CollectionFileName As String
Dim iValue As Integer

Filename = Dir(Path & "\")

 Do While Len(Filename) > 0
    If InStr(Filename, "[") > 0 And InStr(Filename, "]") > 0 Then
        PartName = Left(Filename, InStr(Filename, "[") - 1) & Right(Filename, InStr(Filename, "]") + 1)
        Issue = Mid(Filename, InStr(Filename, "[") + 1, InStr(Filename, "]") - InStr(Filename, "[") - 1)
        If MyCollection.Count <> 0 Then

            For Each i In MyCollection
                MsgBox "Start for each loop" & vbNewLine & "Line being searched:" & vbNewLine & i
                CollectionFileName = Right(Dir(i), Len(i) - Len(Path))
                If Left(CollectionFileName, InStr(CollectionFileName, "[") - 1) & Right(CollectionFileName, InStr(CollectionFileName, "]") + 1) = PartName Then
                    If Mid(CollectionFileName, InStr(CollectionFileName, "[") + 1, InStr(CollectionFileName, "]") - InStr(CollectionFileName, "[") - 1) > Issue Then
                        MsgBox Filename & vbNewLine & "Not Added, Old part newer issue"
                    Else
                        MsgBox Filename & vbNewLine & "Added, This part was newer issue"
                        iValue = IndexOf(MyCollection, i)
                        MyCollection.Add Path & "\" & Filename
                        MyCollection.Remove iValue
                    End If
                Else
                    MsgBox Filename & vbNewLine & "Added New"
                    MyCollection.Add Path & "\" & Filename
                End If
            Next i

        Else
            MsgBox Filename & vbNewLine & "Added New"
            MyCollection.Add Path & "\" & Filename
        End If
        MsgBox Filename & " Added"
        TotalFiles = TotalFiles + 1
    Else
        MsgBox Filename & " Not Added"
    End If
    Filename = Dir
Loop

MsgBox TotalFiles & " file(s) selected within folder"

Set PullFileNames = MyCollection

End Function

Answer 1

Для тех, кто хочет мой окончательный код, вот он

Я изменил несколько других вещей, касающихся того, как он сортировал файлы и решал, какие из них удалить, но дело в том, что теперь он работает правильно

Спасибо за помощь

Private Sub CommandButton1_Click()

Dim ParentFolder As String
Dim UpdatedFiles As New Collection
Dim myfso As New FileSystemObject
Dim DeletedFiles As Integer

Dim exists As Boolean

Set fldrpicker = Application.FileDialog(msoFileDialogFolderPicker)
With fldrpicker
    .Title = "Select Target Folder"
    .AllowMultiSelect = False
        If .Show <> -1 Then Skip = True
        If Not Skip Then ParentFolder = .SelectedItems(1)
End With

'On Error GoTo ErrHandler
If IsEmpty(ParentFolder) Then GoTo Empt

Set updatefiles = PullUpdatedFileNames(ParentFolder)

Filename = Dir(ParentFolder & "\")

Do While Len(Filename) > 0
    For Each x In updatefiles
'        MsgBox "Stored Memory: " & x & vbNewLine & "File Read:         " & ParentFolder & "\" & Filename
        If ParentFolder & "\" & Filename = x Then
            exists = True
            GoTo skipthisif
        Else
            exists = False
        End If
    Next x
skipthisif:
    If exists = False Then myfso.DeleteFile ParentFolder & "\" & Filename
    If exists = False Then DeletedFiles = DeletedFiles + 1
    Filename = Dir
Loop

MsgBox DeletedFiles & " File(s) deleted from folder"

'ErrHandler:
'MsgBox "Copy error: " & File & vbNewLine & "A File could not be sorted in the source folder "
'Resume Next

GoTo scriptEnd

Empt:
MsgBox "Folder is empty"

scriptEnd:

End Sub

Private Function PullUpdatedFileNames(Path As String) As Collection

Dim MyCollection As New Collection
Dim Filename As String
Dim TotalFiles As Integer

Dim PartName As String
Dim Issue As String

Dim CollectionFileName As String
Dim iValue As Integer

Filename = Dir(Path & "\")

Do While Len(Filename) > 0
    If InStr(Filename, "[") > 0 And InStr(Filename, "]") > 0 Then
        PartName = Left(Filename, InStr(Filename, "[") - 1) & Right(Filename, InStr(Filename, "]") + 1)
        Issue = Mid(Filename, InStr(Filename, "[") + 1, InStr(Filename, "]") - InStr(Filename, "[") - 1)
        If MyCollection.Count <> 0 Then
            For Each i In MyCollection
                CollectionFileName = Right(i, Len(i) - InStrRev(i, "\"))
                If Left(CollectionFileName, InStr(CollectionFileName, "[") - 1) & Right(CollectionFileName, InStr(CollectionFileName, "]") + 1) = PartName Then
                    If Mid(CollectionFileName, InStr(CollectionFileName, "[") + 1, InStr(CollectionFileName, "]") - InStr(CollectionFileName, "[") - 1) > Issue Then
                        GoTo nextiteration
                    Else
'                        MsgBox Left(CollectionFileName, InStr(CollectionFileName, "[") - 1) & Right(CollectionFileName, InStr(CollectionFileName, "]") + 1) & vbNewLine & PartName
'                        MsgBox Mid(CollectionFileName, InStr(CollectionFileName, "[") + 1, InStr(CollectionFileName, "]") - InStr(CollectionFileName, "[") - 1) & vbNewLine & Issue
                        iValue = IndexOf(MyCollection, i)
                        MyCollection.Add Path & "\" & Filename
                        MyCollection.Remove iValue
                        GoTo nextiteration
                    End If
                End If
            Next i
            MyCollection.Add Path & "\" & Filename
        Else
            MyCollection.Add Path & "\" & Filename
        End If

nextiteration:
        TotalFiles = TotalFiles + 1
    Else
    End If
    Filename = Dir
Loop

MsgBox TotalFiles & " file(s) recognised within folder"

Set PullUpdatedFileNames = MyCollection

End Function

Public Function IndexOf(ByVal coll As Collection, ByVal item As Variant) As Long
    Dim z As Long
    For z = 1 To coll.Count
        If coll(z) = item Then
            IndexOf = z
            Exit Function
        End If
    Next
End Function