求助：调试将指定文件夹工作表导入主工作簿的VBA代码

需要将StatConverter文件夹下Users子文件夹中的所有Excel文件的工作表，导入到名为import-sheets.xlsm的主工作簿中作为独立工作表。参考论坛示例编写并适配VBA代码后，代码无任何报错但完全不运行，无法排查问题。

用户编写的路径定义代码：

Dim FolderName As String
FolderName = Environ$("userprofile") & "\OneDrive - {Redacted}\Desktop\StatConverter\Users\"

参考的示例代码：

Sub Import()

Dim directory As String, fileName As String, sheet As Worksheet, total As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

directory = Environ$("userprofile") & "\OneDrive - {Redacted}\Desktop\StatConverter\Users\"
fileName = Dir(directory & "*.xl??")

Do While fileName <> ""

    Workbooks.Open (directory & fileName)
    
    For Each sheet In Workbooks(fileName).Worksheets
    
        total = Workbooks("import-sheets.xlsm").Worksheets.Count
        Workbooks(fileName).Worksheets(sheet.Name).Copy _
        after:=Workbooks("import-sheets.xlsm").Worksheets(total)
        
        Workbooks(fileName).Close
        
        fileName = Dir()
        
    Next sheet

Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

原代码存在几个关键问题，导致无响应且不报错：

• 文件关闭时机错误：在For Each sheet循环内就关闭了源工作簿，后续工作表循环时会找不到文件对象，直接中断流程
• Dir()调用位置错误：fileName = Dir()放在工作表循环内，会提前获取下一个文件名，打乱外层Do While的循环逻辑
• 主工作簿引用风险：直接用文件名Workbooks("import-sheets.xlsm")引用，若主工作簿未打开或文件名有误，错误会被DisplayAlerts = False屏蔽
• OneDrive路径隐患：OneDrive的本地同步路径可能存在特殊字符或实际同步位置不符，导致Dir()找不到目标文件

修正后的代码 #

Sub ImportSheets()
    Dim directory As String, fileName As String
    Dim sourceWB As Workbook, targetWB As Workbook
    Dim ws As Worksheet
    
    ' 禁用屏幕刷新和警告，提升运行效率
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 用当前运行代码的工作簿作为目标，避免依赖固定文件名
    Set targetWB = ThisWorkbook
    
    ' 定义源文件路径
    directory = Environ$("userprofile") & "\OneDrive - {Redacted}\Desktop\StatConverter\Users\"
    ' 确保路径末尾带斜杠，避免拼接错误
    If Right(directory, 1) <> "\" Then directory = directory & "\"
    
    ' 获取路径下第一个Excel文件
    fileName = Dir(directory & "*.xls*")
    
    Do While fileName <> ""
        ' 跳过目标工作簿本身，避免循环导入自己
        If fileName <> targetWB.Name Then
            ' 捕获文件打开错误，防止单个损坏文件中断整个流程
            On Error Resume Next
            Set sourceWB = Workbooks.Open(directory & fileName)
            On Error GoTo 0
            
            ' 确认文件成功打开后再处理
            If Not sourceWB Is Nothing Then
                ' 遍历源工作簿所有工作表
                For Each ws In sourceWB.Worksheets
                    ' 复制工作表到目标工作簿末尾
                    ws.Copy After:=targetWB.Sheets(targetWB.Sheets.Count)
                Next ws
                
                ' 关闭源工作簿，不保存更改
                sourceWB.Close SaveChanges:=False
                Set sourceWB = Nothing ' 释放对象，避免内存占用
            End If
        End If
        
        ' 获取下一个文件名
        fileName = Dir()
    Loop
    
    ' 恢复屏幕刷新和警告
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "工作表导入完成！", vbInformation
End Sub

额外排查步骤 #

• 验证路径有效性：手动打开directory对应的路径，确认存在Excel文件；也可在代码中加入MsgBox directory弹窗，查看实际路径是否正确
• 启用错误提示：临时注释掉Application.DisplayAlerts = False，运行代码查看是否弹出错误信息，定位具体问题
• 检查OneDrive同步状态：确保OneDrive已完成同步，Users文件夹下的文件都已下载到本地（不是仅在线状态）

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