Excel中VBA宏的循环问题

Question

我正在编写一个宏，它从两个不同的位置获取数据并将其粘贴到模板中，将模板保存为新文件，然后循环并重复该过程。宏适用于一个文件，但在循环时失败。具体来说，计算机找不到文件，认为它已被移动或删除。

代码如下:

为节省空间，不包含

子字符和暗字符

'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

子终结">

我希望这足够清楚。更简洁:

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:TempPrevious", "*.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