VBA使用FileSystemObject遍历子文件夹复制数据无效果问题

代码无报错但未写入有效数据，核心是4处逻辑错误：

1. 行号变量r是递归过程的局部变量：每次递归进入子文件夹调用GetFiles时，都会重新执行r=0重置行号，不同子文件夹的写入操作会互相覆盖行位置，最终只会残留最后一个处理的文件夹的文件数据，甚至因覆盖顺序问题看起来完全没有写入内容。
2. 目标工作表引用依赖ActiveWorkbook不稳定：打开源文件时系统会自动将焦点切到新打开的源工作簿，若遇到文件打开事件触发、权限弹窗等特殊情况，ActiveWorkbook会指向源文件，而源文件内没有Report工作表时，写入操作会直接静默失效。
3. 未做文件类型过滤：指定目录下如果存在临时文件、快捷方式、非Excel格式文件，Workbooks.Open会尝试打开这类无效文件，读不到Dashboard工作表时操作直接失败，也不会抛出明确报错。
4. 初始行偏移逻辑错误：需求是从A2开始写入第一行数据，但初始r=0时，第一个文件执行r=r+1后会偏移1行写入A3，A2单元格永远为空。

将行号、目标表定义为模块级变量，避免递归过程中重复重置，同时增加文件过滤、固定目标工作簿引用：

' 模块级全局变量，递归遍历过程中持续累计，不会被重置
Dim destSheet As Worksheet
Dim r As Long

Sub Copdata()
    ' 初始化配置仅在启动时执行一次
    Set destSheet = ThisWorkbook.Worksheets("Report")
    r = 0
    ' 关闭屏幕更新、系统弹窗提升遍历速度
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Call GetFiles("D:\data\Analysis\records\")
    
    ' 恢复系统默认设置
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "数据提取完成，共处理 " & r & " 个文件", vbInformation
End Sub

Sub GetFiles(ByVal path As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim folder As Object
    Set folder = fso.GetFolder(path)

    Dim subfolder As Object
    Dim file As Object
    Dim fromWorkbook As Workbook
    Dim sourceSheet As Worksheet

    ' 先递归遍历所有层级子文件夹
    For Each subfolder In folder.SubFolders
        GetFiles subfolder.path
    Next subfolder

    ' 处理当前文件夹下的有效Excel文件
    For Each file In folder.Files
        ' 过滤规则：仅处理xls/xlsx/xlsm格式文件，跳过Office生成的~$开头临时文件
        If LCase(fso.GetExtensionName(file.path)) Like "xls*" And Left(file.Name, 2) <> "~$" Then
            Set fromWorkbook = Workbooks.Open(Filename:=file.path, ReadOnly:=True)
            
            ' 校验源文件是否存在Dashboard工作表，不存在则跳过
            On Error Resume Next
            Set sourceSheet = fromWorkbook.Worksheets("Dashboard")
            If Not sourceSheet Is Nothing Then
                ' 从A2开始逐行写入，写完再累计行号
                destSheet.Range("A2").Offset(r).Value = sourceSheet.Range("C5").Value
                destSheet.Range("B2").Offset(r).Value = sourceSheet.Range("D51").Value
                r = r + 1
            End If
            Err.Clear
            On Error GoTo 0
            
            fromWorkbook.Close savechanges:=False
            Set sourceSheet = Nothing
        End If
    Next file

    ' 释放对象占用
    Set fso = Nothing
    Set folder = Nothing
    Set subfolder = Nothing
    Set file = Nothing
    Set fromWorkbook = Nothing
End Sub

• 代码用ThisWorkbook固定指代存储这段VBA代码的目标工作簿，不会因为窗口焦点切换找错写入位置。
• 新增的文件过滤、工作表存在性校验逻辑，会自动跳过无效文件、结构不符合要求的文件，不会打断整体遍历流程。
• 以只读模式打开源文件，不会因为文件被其他用户占用导致打开失败。

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