Excel VBA导入最新ATP报表报错：指定文件夹无数据的问题求助

问题根源分析 #

• 文件名大小写不匹配：代码中Dir(dataFilePath & "ATP Report *.xlsx")使用大写R的“Report”，但实际文件命名是小写r的“ATP report 20230731”，导致Dir函数无法匹配到目标文件。
• 初始日期设置错误：代码中newestDate = Date将初始日期设为当天，若报表文件日期早于当天，会被判定为不满足fileDate > newestDate，无法被识别为最新文件。
• 未做文件夹存在性校验：如果路径因大小写差异或其他原因不存在，代码不会给出明确提示，直接触发“无数据”报错。

修复后的代码 #

针对上述问题，对代码做了针对性调整，同时增加了容错校验：

Private Sub Workbook_Open()
    ImportDataFromNewestATPReportFile
End Sub

Sub ImportDataFromNewestATPReportFile()
    Dim mainWorkbook As Workbook
    Dim dataWorkbook As Workbook
    Dim mainWorksheet As Worksheet
    Dim dataWorksheet As Worksheet
    Dim dataFilePath As String
    Dim dataLastRow As Long
    Dim mainLastRow As Long
    Dim dataFilename As String
    Dim newestFile As String
    Dim newestDate As Date

    ' 桌面ATP Report文件夹路径（与实际文件夹名大小写保持一致）
    dataFilePath = Environ("USERPROFILE") & "\Desktop\ATP Report\"

    ' 先检查文件夹是否存在
    If Dir(dataFilePath, vbDirectory) = "" Then
        MsgBox "指定的ATP报表文件夹不存在，请检查路径。", vbCritical
        Exit Sub
    End If

    Debug.Print "文件夹路径: " & dataFilePath

    Set mainWorkbook = ThisWorkbook
    Set mainWorksheet = mainWorkbook.Sheets("Details-lines")

    ' 初始化最新日期为极小值，确保所有有效日期的文件都能被检测
    newestDate = DateSerial(1900, 1, 1)

    ' 用不区分大小写的规则匹配文件名，同时与实际前缀保持一致
    dataFilename = Dir(dataFilePath & "ATP report *.xlsx", vbTextCompare)

    Do While dataFilename <> ""
        Dim dateString As String
        ' 提取日期部分："ATP report 20230731.xlsx" 前缀共11个字符，从第12位取8位日期串
        dateString = Mid(dataFilename, 12, 8)
        Dim fileDate As Date
        On Error Resume Next
        fileDate = DateSerial(CInt(Mid(dateString, 1, 4)), CInt(Mid(dateString, 5, 2)), CInt(Mid(dateString, 7, 2)))
        On Error GoTo 0

        ' 仅处理有效日期的文件
        If IsDate(fileDate) Then
            If fileDate > newestDate Then
                newestDate = fileDate
                newestFile = dataFilename
            End If
        Else
            Debug.Print "无效日期格式的文件: " & dataFilename
        End If

        dataFilename = Dir
    Loop

    If newestFile <> "" Then
        Set dataWorkbook = Workbooks.Open(dataFilePath & newestFile)
        ' 检查目标工作表是否存在
        On Error Resume Next
        Set dataWorksheet = dataWorkbook.Sheets("ATP Report")
        On Error GoTo 0

        If dataWorksheet Is Nothing Then
            MsgBox "打开的文件中不存在名为'ATP Report'的工作表。", vbExclamation
            dataWorkbook.Close False
            Exit Sub
        End If

        dataLastRow = dataWorksheet.Cells(dataWorksheet.Rows.Count, "A").End(xlUp).Row
        mainLastRow = mainWorksheet.Cells(mainWorksheet.Rows.Count, "A").End(xlUp).Row

        ' 遍历主表Item匹配数据，跳过空行
        Dim i As Long
        For i = 2 To mainLastRow
            Dim Item As String
            Item = mainWorksheet.Cells(i, "A").Value

            If Item <> "" Then
                Dim j As Long
                For j = 2 To dataLastRow
                    If dataWorksheet.Cells(j, "A").Value = Item Then
                        mainWorksheet.Cells(i, "U").Value = dataWorksheet.Cells(j, "B").Value
                        mainWorksheet.Cells(i, "V").Value = dataWorksheet.Cells(j, "C").Value
                        Exit For
                    End If
                Next j
            End If
        Next i

        Application.CutCopyMode = False
        dataWorkbook.Close False
        MsgBox "数据导入完成，最新文件: " & newestFile, vbInformation
    Else
        MsgBox "指定文件夹中未找到符合格式的ATP报表文件。", vbExclamation
    End If
End Sub

额外注意事项 #

• 确保报表文件内的工作表名称确实为“ATP Report”，若名称不一致需修改代码中对应工作表名称的部分
• 若文件格式不是.xlsx（如.xls或.xlsm），需调整Dir函数中的文件后缀匹配规则
• 可通过VBA编辑器的“立即窗口”（Ctrl+G）查看打印的文件夹路径和无效文件提示，辅助排查问题

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