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

嵌套在VBA中的每个内部Do

1 个答案: