VBA编写文件夹数据导入宏：自定义查询名、指定位置、过滤临时文件求助

核心需求实现逻辑 #

• 动态生成Power Query名称：提取目标文件夹路径的最后一级名称，直接拼接_current或_future后缀作为查询名，无需硬编码
• 指定位置导入：取消原有自动新建工作表的逻辑，直接指定目标工作表（如worksheet 2）的B2单元格作为导入起始位，只要查询最终返回5列数据就会自动填充B-F列
• 过滤临时文件：在Power Query的M公式中新增筛选步骤，排除Name字段以~$开头的Office临时文件

注意：你原有代码首行存在拼写错误，ub Macro3()缺少首字母S，正确写法应为Sub Macro3()，否则运行会直接触发语法错误。

修正后完整可运行代码 #

Sub ImportFolderData()
    ' ========== 按需修改以下配置参数 ==========
    Const TARGET_FOLDER_PATH As String = "C:\Users\N14067\Documents\Training\VBA\Training 1" ' 待扫描的目标文件夹路径
    Const QUERY_SUFFIX As String = "_current" ' 切换为"_future"即可更换查询后缀
    Const TARGET_SHEET_NAME As String = "worksheet 2" ' 数据导入的目标工作表
    Const IMPORT_START_RANGE As String = "B2" ' 导入起始单元格，对应B-F列区域的左上角
    ' ==========================================

    Dim folderName As String, queryName As String
    Dim targetWs As Worksheet
    Dim pqMFormula As String

    ' 提取文件夹名拼接生成Power Query名称
    folderName = Mid(TARGET_FOLDER_PATH, InStrRev(TARGET_FOLDER_PATH, "\") + 1)
    queryName = folderName & QUERY_SUFFIX

    ' 容错：删除已存在的同名旧查询，避免重复创建报错
    On Error Resume Next
    ActiveWorkbook.Queries(queryName).Delete
    ActiveWorkbook.Worksheets(TARGET_SHEET_NAME).ListObjects(Replace(queryName, " ", "_") & "_List").Delete
    On Error GoTo 0

    ' 构造Power Query M公式，新增临时文件过滤逻辑
    pqMFormula = "let" & Chr(13) & Chr(10) & _
        "    Source = Folder.Files(""" & TARGET_FOLDER_PATH & """)," & Chr(13) & Chr(10) & _
        "    FilterTempFile = Table.SelectRows(Source, each not Text.StartsWith([Name], ""~$""))," & Chr(13) & Chr(10) & _
        "    KeepNeededCols = Table.SelectColumns(FilterTempFile, {""Name"", ""Extension"", ""Date modified"", ""Date created"", ""Folder Path""})" & Chr(13) & Chr(10) & _
        "in" & Chr(13) & Chr(10) & _
        "    KeepNeededCols"

    ' 创建新的Power Query查询
    ActiveWorkbook.Queries.Add Name:=queryName, Formula:=pqMFormula

    ' 绑定目标工作表
    Set targetWs = ActiveWorkbook.Worksheets(TARGET_SHEET_NAME)

    ' 加载查询结果到指定位置
    With targetWs.ListObjects.Add( _
        SourceType:=0, _
        Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""" & queryName & """;Extended Properties="""""", _
        Destination:=targetWs.Range(IMPORT_START_RANGE) _
    ).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & queryName & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = Replace(queryName, " ", "_") & "_List"
        .Refresh BackgroundQuery:=False
    End With
End Sub

使用说明 #

• 所有可调整的参数都集中在代码开头的常量区域，不需要修改后续逻辑即可切换文件夹路径、查询后缀、导入位置
• M公式中KeepNeededCols步骤保留了5个字段（文件名、扩展名、修改时间、创建时间、所在路径），刚好匹配B-F列的宽度，如果需要调整导入的字段，增减这个步骤里的字段名即可，注意字段数量和你需要的列数保持一致
• 代码增加了重复运行容错，每次执行会自动清理同名的旧查询和旧列表对象，不会出现重复创建的报错

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