基于参考列表筛选CSV文件导入Excel的VBA代码修改需求

现有Excel文件已通过VBA实现：按用户输入的日期，导入对应文件夹下所有CSV文件，功能运行正常。现需修改代码，仅导入文件名以主工作表指定参考列表内名称开头的CSV文件。

举例说明：

• 目标文件夹内的CSV文件名：
  • File1-basic.csv
  • File1-extended.csv
  • File2-basic.csv
  • File2-extended.csv
  • File3-basic.csv
  • File3-extended.csv
  • File4-basic.csv
  • File4-extended.csv
• 主工作表NameList的A列（从A2开始）存储的参考列表：
  • File1
  • File3

要求仅导入以File1和File3开头的文件，忽略其余文件。原代码会导入目标文件夹内所有文件，需针对性修改。

Public Sub CombineFiles()
    Dim i As Integer
    Dim myValue As Variant
    Dim strPath As String
    Dim S As Worksheet
    Dim boolGetHeaders As Boolean
    Dim LastRowColumnA As Long
    Dim myCell As Range
    Dim strFilePattern As String
    Dim strFileName As String

    myValue = InputBox("请输入要导入几天前的数据？(0=今天)", "日期回溯", 0)
    
    ' 校验输入是否为数字
    If Not IsNumeric(myValue) Then
        MsgBox "仅支持数字输入", 48, "输入错误"
        Exit Sub
    End If
    
    Sheets("Dashboard").Range("K3").Value = "LOADING"
    Sheets("ImportedData").Cells.Clear
    Sheets("DuplicateRecords").Cells.Clear
    
    ThisWorkbook.Activate
    Set S = ThisWorkbook.Worksheets("ImportedData")
    boolGetHeaders = True

    ' 构建目标文件夹路径
    strPath = "folderpath" & Format(DateAdd("d", -myValue, Date), "yyyy-MM-dd") & "\"
    If Dir$(strPath) = "" Then
        MsgBox "未找到文件夹 - " & strPath, 48, "文件夹不存在"
        Exit Sub
    End If

    ' 遍历NameList中的参考名称
    With ThisWorkbook.Worksheets("NameList")
        LastRowColumnA = .Range("A" & .Rows.Count).End(xlUp).Row
        
        For Each myCell In .Range("A2:A" & LastRowColumnA)
            ' 构建匹配模式：参考名称开头，后续是-*.csv
            strFilePattern = myCell.Value & "-*.csv"
            strFileName = Dir(strPath & strFilePattern)
            
            ' 遍历该模式下的所有CSV文件
            Do While strFileName <> ""
                ' 导入CSV到新工作表
                Sheets.Add Type:=strPath & strFileName, After:=Worksheets(Worksheets.Count)
                ' 处理下一个匹配文件
                strFileName = Dir()
            Loop
            
            ' 如果没有找到匹配文件，标记提示
            If Dir(strPath & strFilePattern) = "" Then
                myCell.Offset(0, 7).Value = "未找到文件"
            End If
        Next myCell
    End With

    Sheets("Dashboard").Range("K3").Value = "完成"
End Sub

• 移除冗余的全量导入逻辑：删除原代码中会导入所有文件的FindFilesFromFolders调用，仅按指定名称模式筛选文件。
• 批量匹配文件：通过Dir()函数的循环特性，一次性获取所有符合参考名称-*.csv模式的文件，避免仅导入第一个匹配项。
• 明确对象引用：全程使用ThisWorkbook指向当前工作簿，避免因激活外部工作簿导致的错误。
• 优化用户反馈：导入完成后更新Dashboard的状态提示，提升操作体验。

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