Excel VBA批量处理文件夹xlsx文件循环无法打开下一文件问题求助

问题根因 #

你的循环提前终止的核心原因是循环内部错误调用了Dir()函数，重置了遍历状态：

• 初始化时你用MyFile = Dir(MyFolder & "*.xlsx")启动了对目标文件夹下xlsx文件的遍历，Dir本身会维护当前遍历的进度状态
• 但循环中你写了Cells(1, LC3 + 1) = Dir(WB2.Name)，这行代码调用了带参数的Dir()，会直接打断之前的遍历任务，重置Dir的内部状态，导致后续执行MyFile = Dir()时直接返回空值，循环终止

解决方案 #

你这里要取的就是已打开工作簿的文件名，根本不需要调用Dir()，直接用WB2.Name即可，修改对应行就能解决问题。

修正后完整代码 #

Sub open_and_close()

Dim MyFolder As String
Dim MyFile As Variant
Dim LC3 As Long
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim targetSheet As Worksheet ' 新增变量固定目标工作表，避免Activate带来的错误

Set WB1 = ThisWorkbook
Set targetSheet = WB1.Sheets("Test Script Scenario 1") ' 提前绑定目标工作表，不需要每次激活

MyFolder = "C:\Users\x\y\z\Test script\"
MyFile = Dir(MyFolder & "*.xlsx")

Do While MyFile <> ""
    Set WB2 = Workbooks.Open(MyFolder & MyFile) ' 直接用Open的返回值赋值，不需要依赖ActiveWorkbook
    WB2.Sheets("Test Script Scenario 1").Range("J3:J99").Copy
    LC3 = targetSheet.Cells(3, targetSheet.Columns.Count).End(xlToLeft).Column
    targetSheet.Cells(3, LC3 + 1).PasteSpecial Paste:=xlPasteValues
    targetSheet.Cells(1, LC3 + 1) = WB2.Name ' 去掉错误的Dir调用，直接取工作簿名
    WB2.Close savechanges:=False
    MyFile = Dir() ' 此时Dir的遍历状态不会被打断，能正常取下一个文件
Loop
' 清理剪贴板
Application.CutCopyMode = False
End Sub

额外优化建议 #

• 尽量不要用Activate、ActiveWorkbook这类依赖活动窗口的方法，很容易因为用户操作或者代码逻辑切换窗口导致取值错误，直接通过对象变量绑定工作表/工作簿更稳定
• 遍历结束后清空剪贴板，避免残留复制内容弹出提示
• 可以加上错误处理，跳过不存在指定工作表的文件，避免宏直接崩溃：

' 可以在打开文件后加错误捕获
On Error Resume Next
Dim sourceSheet As Worksheet
Set sourceSheet = WB2.Sheets("Test Script Scenario 1")
On Error GoTo 0
If sourceSheet Is Nothing Then
    WB2.Close savechanges:=False
    MyFile = Dir()
    GoTo continueLoop ' 跳过没有对应工作表的文件
End If

内容的提问来源于stack exchange，提问作者Eduardo Farkuh