VBA宏执行异常：遍历文件夹Excel文件时跳过Do While后续代码求助

嘿，作为VBA新手碰到这种问题太正常了！你说代码执行到Do While FileName <> ""就跳过后续逻辑，核心原因几乎肯定是**FileName变量一开始就是空值**，导致循环直接不执行。下面一步步帮你排查修复：

问题根源分析 #

这段MSDN示例代码里，FileName是靠Dir函数获取文件夹里的文件的。如果Dir没返回任何文件名，循环自然就直接跳过了。常见的触发原因有这几个：

• 你的FolderPath没有以反斜杠\结尾，比如写成了C:\MyFiles而不是C:\MyFiles\，导致Dir(FolderPath & "*.xlsx")变成了无效路径
• 你指定的文件夹里没有匹配的Excel文件（比如代码找的是.xlsx，但你文件夹里都是.xls）
• 第一次调用Dir的语句写错了，没正确关联FolderPath

具体修复步骤 #

1. 确保FolderPath格式正确 #

在给FolderPath赋值的时候，一定要加上结尾的反斜杠：

FolderPath = "C:\你要处理的文件夹路径\" ' 注意最后有个\

如果想让用户手动选择文件夹，用FileDialog可以自动处理路径格式，更稳妥：

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then
    FolderPath = fd.SelectedItems(1) & "\"
Else
    MsgBox "未选择文件夹，程序退出"
    Exit Sub
End If

2. 正确初始化FileName #

第一次调用Dir要明确指定文件类型，比如针对.xlsx文件：

FileName = Dir(FolderPath & "*.xlsx") ' 获取第一个xlsx文件

如果要包含旧版.xls文件，可以写成"*.xls*"，或者分开指定不同后缀。

3. 完善循环内的逻辑 #

循环里一定要记得再次调用Dir()来获取下一个文件，不然要么陷入死循环，要么直接中断：

Do While FileName <> ""
    ' 这里写你的文件打开、数据提取逻辑
    ' ...
    
    ' 关键：获取下一个文件
    FileName = Dir()
Loop

修正后的完整示例代码 #

Sub MergeAllWorkbooks()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim NRow As Long
    Dim FileName As String
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range
    
    ' 创建汇总工作表
    Set SummarySheet = ThisWorkbook.Worksheets.Add
    SummarySheet.Name = "汇总数据"
    
    ' 让用户选择目标文件夹
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    If fd.Show = -1 Then
        FolderPath = fd.SelectedItems(1) & "\"
    Else
        MsgBox "未选择文件夹，程序退出"
        Exit Sub
    End If
    
    ' 获取第一个Excel文件
    FileName = Dir(FolderPath & "*.xlsx")
    NRow = 2 ' 从第二行开始写入（第一行当表头）
    
    Do While FileName <> ""
        ' 打开文件（只读模式避免锁定原文件）
        Set WorkBk = Workbooks.Open(FolderPath & FileName, ReadOnly:=True)
        
        ' 假设要提取第一个工作表的A1:D10区域，根据你的实际需求修改
        Set SourceRange = WorkBk.Worksheets(1).Range("A1:D10")
        
        ' 确定汇总表的目标写入区域
        Set DestRange = SummarySheet.Range("A" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
        
        ' 复制数据（直接赋值比复制粘贴更高效）
        DestRange.Value = SourceRange.Value
        
        ' 关闭文件，不保存任何修改
        WorkBk.Close SaveChanges:=False
        
        ' 更新下一行写入位置
        NRow = NRow + SourceRange.Rows.Count
        
        ' 获取下一个文件
        FileName = Dir()
    Loop
    
    MsgBox "汇总完成！"
End Sub

调试小技巧 #

如果还是有问题，可以在Do While之前加一句MsgBox FileName，看看弹出的内容：

• 如果是空的，说明路径不对或者文件夹里没有对应类型的文件
• 如果有文件名，那就是循环内的逻辑有问题，可以用F8键逐步调试排查

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