为什么我在运行此代码时会丢失文件对象？

Question

这是我的代码。

Dim fso As New FileSystemObject
Dim trgtMchnFldr As Object
Dim fldr As Object
Dim sbFldr As Object
Dim BOMFl As Object
Dim chngOvrFl As Object
Dim mchnSpecFl As Object
Dim flFound As Object
Dim queue As Collection

Dim flToFindName() As Variant
Dim flName As Variant
ReDim mchnSubFldrArr(0) As Variant
ReDim BOMFlArr(0) As Variant
ReDim chngFlArr(0) As Variant
ReDim mchnSpecFlArr(0) As Variant


arrysToSet = Array(mchnSubFldrArr, BOMFlArr, chngFlArr, mchnSpecFlArr)
For Each itm In arrysToSet
    Set itm(0) = Nothing
Next itm

Set trgtMchnFldr = mchnFldr(Range("A1"))
If trgtMchnFldr Is Nothing Then
    MsgBox "This machine does not exist."
    Exit Sub
End If

billofMtr = Array("Bill of Material", "BOM")
chngOvr = Array("Changeover", "Change Over")
mchnSpec = Array("Machine Spec", "Spec_Sheet", "Specs", "Spec Sheet")
flNmOrganize = Array(billofMtr, chngOvr, mchnSpec)

Set queue = New Collection

queue.Add trgtMchnFldr

Do While queue.Count > 0
    Set fldr = queue(1)
    queue.Remove 1
    Debug.Print fldr.Files.Count
    If fldr.Files.Count > 0 Then
        For Each fl In fldr.Files
            Set flFound = fl
            For flType = 0 To UBound(flNmOrganize)
                For flNm = 0 To UBound(flNmOrganize(flType))
                    If InStr(1, flFound.Name, flNmOrganize(flType)(flNm)) > 0 Then
                        If flType = 0 Then
                            If BOMFlArr(0) = Empty Then
                                ReDim Preserve BOMFlArr(0)
                                Set BOMFlArr(0) = flFound
                                GoTo nextFl:
                            Else
                                ReDim Preserve BOMFlArr(UBound(BOMFlArr) + 1)
                                Set BOMFlArr(UBound(BOMFlArr)) = flFound
                                GoTo nextFl:
                            End If
                        ElseIf flType = 1 And Not flFound Like "*.pdf" Then
                             If chngFlArr(0) = Empty Then
                                ReDim Preserve chngFlArr(0)
                                Set chngFlArr(0) = flFound
                                GoTo nextFl:
                            Else
                                ReDim Preserve chngFlArr(UBound(chngFlArr) + 1)
                                Set chngFlArr(UBound(chngFlArr)) = flFound
                                GoTo nextFl:
                            End If
                        ElseIf flType = 2 Then
                             If mchnSpecFlArr(0) = Empty Then
                                ReDim Preserve mchnSpecFlArr(0)
                                Set mchnSpecFlArr(0) = flFound
                                GoTo nextFl:
                            Else
                                ReDim Preserve mchnSpecFlArr(UBound(mchnSpecFlArr) + 1)
                                Set mchnSpecFlArr(UBound(mchnSpecFlArr)) = flFound
                                GoTo nextFl:
                            End If
                        End If
                    End If
                Next flNm
            Next flType
nextFl:
        Next fl
    End If
    For Each sbFldr In fldr.SubFolders
        If sbFldr.Name <> "P1-Inquiry_Proposal" Then
            queue.Add sbFldr
        End If
    Next sbFldr
Loop


errMsg = "Cannot find the file."
Set BOMFl = flNewFile(BOMFlArr())
If BOMFl Is Nothing Then
    Range("E12") = errMsg
Else
    Range("E12").Value = BOMFl.Path
End If

Set chngOvrFl = flNewFile(chngFlArr())
If chngOvrFl Is Nothing Then
    Range("E7") = errMsg
Else
   Range("E7") = chngOvrFl.Path
End If
Set mchnSpecFl = flNewFile(mchnSpecFlArr())
If mchnSpecFl Is Nothing Then
    Range("E13") = errMsg
Else
    Range("E13") = mchnSpecFl.Path
End If
End Sub 

我似乎丢失了本节中的文件（如下所示）。我已尝试尽快获取该文件，但是当我单步执行代码时，我将在本地窗口 <应用程序定义或对象定义的错误> 中收到错误。程序识别出那里有一个文件。如果我转到“立即窗口”并将属性应用于对象，即。 ?fl.Name，立即窗口将返回该属性的值。一旦我从文件对象中检索到值，该文件就会重新出现在本地窗口中。

            Set flFound = fl
            For flType = 0 To UBound(flNmOrganize)
                For flNm = 0 To UBound(flNmOrganize(flType))
                    If InStr(1, flFound.Name, flNmOrganize(flType)(flNm)) > 0 Then
                        If flType = 0 Then
                            If BOMFlArr(0) = Empty Then
                                ReDim Preserve BOMFlArr(0)
                                Set BOMFlArr(0) = flFound
                                GoTo nextFl:
                            Else
                                ReDim Preserve BOMFlArr(UBound(BOMFlArr) + 1)
                                Set BOMFlArr(UBound(BOMFlArr)) = flFound
                                GoTo nextFl:
                            End If
                        ElseIf flType = 1 And Not flFound Like "*.pdf" Then
                             If chngFlArr(0) = Empty Then
                                ReDim Preserve chngFlArr(0)
                                Set chngFlArr(0) = flFound
                                GoTo nextFl:
                            Else
                                ReDim Preserve chngFlArr(UBound(chngFlArr) + 1)
                                Set chngFlArr(UBound(chngFlArr)) = flFound
                                GoTo nextFl:
                            End If
                        ElseIf flType = 2 Then
                             If mchnSpecFlArr(0) = Empty Then
                                ReDim Preserve mchnSpecFlArr(0)
                                Set mchnSpecFlArr(0) = flFound
                                GoTo nextFl:
                            Else
                                ReDim Preserve mchnSpecFlArr(UBound(mchnSpecFlArr) + 1)
                                Set mchnSpecFlArr(UBound(mchnSpecFlArr)) = flFound
                                GoTo nextFl:
                            End If
                        End If
                    End If
                Next flNm
            Next flType
nextFl:
        Next fl

我复制了我试图从中检索文件的整个文件夹，它检索了文件夹，没有任何问题。因为我确信这是服务器端的东西，有什么方法可以绕过这个问题？

Answer 1

遵循代码中的逻辑非常困难，主要是由于大量数组（一些是嵌套的）。如果您重新组织一下，并且可能使用集合来存储找到的文件，您可能会发现更容易调试。

根据我对您发布的代码的理解（可能有点偏离......），这应该接近：

Sub Tester()

    Dim fl As Object, fldr As Object, sbFldr As Object
    Dim colBOM As New Collection, colChange As New Collection
    Dim colSpec As New Collection, trgtMchnFldr As Object
    Dim queue As New Collection, fso As Object
    
    Set fso = CreateObject("scripting.filesystemobject")
    
    Set trgtMchnFldr = fso.getfolder("C:\Temp\")
    queue.Add trgtMchnFldr
    
    Do While queue.Count > 0
        Set fldr = queue(1)
        queue.Remove 1
        
        For Each fl In fldr.Files
            If NameMatch(fl.Name, Array("Bill of Material", "BOM")) Then
                colBOM.Add fl
            ElseIf NameMatch(fl.Name, Array("Changeover", "Change Over")) Then
                If Not fl.Name Like "*.pdf" Then colChange.Add fl
            ElseIf NameMatch(fl.Name, Array("Machine Spec", "Spec_Sheet", "Specs", "Spec Sheet")) Then
                colSpec.Add fl
            End If
        Next fl
        
        'sub folders for processing
        For Each sbFldr In fldr.SubFolders
            If sbFldr.Name <> "P1-Inquiry_Proposal" Then
                queue.Add sbFldr
            End If
        Next sbFldr
    Loop
    
    'do something with colBOM, colChange, colSpec
End Sub

'does the string `nm` contain any of the strings in `arr`?
Function NameMatch(nm, arr) As Boolean
    Dim e
    For Each e In arr
        If InStr(1, nm, e, vbTextCompare) > 0 Then
            NameMatch = True
            Exit Function
        End If
    Next e
End Function