使用 Excel VBA 循环遍历两个位置的文件

Question

我正在编写一个宏，它从两个位置获取数据，将其粘贴到模板中，将模板另存为新文件，然后重复该过程。

该宏适用于一个文件，但在循环时失败。它找不到该文件并认为它已被移动或删除。

'sub and dims excluded to save space
    
    'set folder locations
    dataFolder = "C:\Location\" 'abbreviated
    previousFolder = "C:\Other Location\" 'abbreviated
    
    'set file names
    dataFile = Dir(dataFolder & "*.xls*")
    previousFile = Dir(previousFolder & "*.xls*")
    
    Do While dataFile <> ""

        Set dataWB = Workbooks.Open(dataFolder & dataFile)'this is where the code breaks on looping
        
            'the contents of the loop work fine on the first go so I am excluding them
        
        'Save file to directory
        ActiveWorkbook.SaveAs ("C:\Save Location\") 
                
    'how I am ending the loop
    dataFile = Dir
    previousFile = Dir
    
    Loop

End Sub

更简洁：

dataFile = Dir(dataFolder & "*.xls*")
previousFile = Dir(previousFolder & "*.xls*")

Do While dataFile <> "" 'breaks here after succeeding with first file

'stuff to do

dataFile = Dir
previousFile = Dir

Loop

我希望程序获取源文件夹中的下一个文件并重复该过程，但它中断说它无法找到下一个文件（即使它在该错误消息中返回文件名）。

Answer 1

如果将文件循环推送到单独的函数中，则可以更轻松地处理多个文件位置：

Sub tester()
    Dim files As Collection, filesPrev As Collection
    
    Set files = MatchedFiles("C:\Temp\", "*.xls*")
    Set filesPrev = MatchedFiles("C:\Temp\Previous\", "*.xls*")
    
    Debug.Print files.Count, filesPrev.Count
    
    'do something with file names in the collections
    
End Sub

'Return a collection of file paths
Function MatchedFiles(ByVal fldr As String, pattern As String) As Collection
    Dim f
    If Right(fldr, 1) <> "\" Then fldr = fldr & "\"
    Set MatchedFiles = New Collection
    f = Dir(fldr & pattern)
    Do While Len(f) > 0
        MatchedFiles.Add fldr & f
        f = Dir()
    Loop
End Function