创建PowerQuery遇Token错误，如何实现动态文件夹路径？

错误原因拆解 #

1. Runtime-error '1004'（Source未识别） #

• 代码重复定义了Sub AddSaveQuery()，导致变量SourcePath作用域混乱，PowerQuery公式里的路径参数未正确传递
• PowerQuery公式拼接出现断裂：比如#""Removed Other Columns"" = Table.SelectColumns(#""Column1"" & _""ed Type"""是语法错误，应该是#""Changed Type""，断裂的公式直接导致PowerQuery无法识别Source步骤

2. Runtime Error '1004'（对象定义错误） #

• 单元格用CONCAT生成的SourcePath包含多余双引号（比如"""C:\Test"""），拼接后PowerQuery公式变成Folder.Files("""C:\Test""")，路径格式非法
• 硬编码工作簿名CognosDataCleaner2.xlsm和Book1，如果工作簿名修改或不存在，会引发连接创建失败
• 重复添加相同连接，且操作未激活的工作簿，触发对象引用错误

修复后的完整代码 #

Sub AddSaveQuery()
    'Set Objects
    Dim SourcePath As String
    Dim SavePath As String
    Dim wsNew As Worksheet
    
    '直接读取纯路径，单元格无需额外加引号
    SourcePath = Worksheets("Home").Range("G21").Value
    SavePath = Worksheets("Home").Range("G8").Value
    
    '删除已存在的同名查询，避免重复添加报错
    On Error Resume Next
    ActiveWorkbook.Queries("Data").Delete
    ActiveWorkbook.Queries("Parameter1").Delete
    ActiveWorkbook.Queries("Transform Sample File").Delete
    ActiveWorkbook.Queries("Sample File").Delete
    ActiveWorkbook.Queries("Transform File").Delete
    On Error GoTo 0
    
    '创建主Data查询，修复公式拼接错误
    ActiveWorkbook.Queries.Add Name:="Data", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Folder.Files(""" & SourcePath & """)," & Chr(13) & "" & Chr(10) & _
        "    #""Filtered Hidden Files1"" = Table.SelectRows(Source, each [Attributes]?[Hidden]? <> true)," & Chr(13) & "" & Chr(10) & _
        "    #""Invoke Custom Function1"" = Table.AddColumn(#""Filtered Hidden Files1"", ""Transform File"", each #""Transform File""([Content]))," & Chr(13) & "" & Chr(10) & _
        "    #""Renamed Columns1"" = Table.RenameColumns(#""Invoke Custom Function1"", {""Name"", ""Source.Name""})," & Chr(13) & "" & Chr(10) & _
        "    #""Removed Other Columns1"" = Table.SelectColumns(#""Renamed Columns1"", {""Source.Name"", ""Transform File""})," & Chr(13) & "" & Chr(10) & _
        "    #""Expanded Table Column1"" = Table.ExpandTableColumn(#""Removed Other Columns1"", ""Transform File"", Table.ColumnNames(#""Transform File""(#""Sample File"")))," & Chr(13) & "" & Chr(10) & _
        "    #""Changed Type"" = Table.TransformColumnTypes(#""Expanded Table Column1"",{{""Source.Name"", type text}, {""Column1"", type any}, {""Column2"", type any}})," & Chr(13) & "" & Chr(10) & _
        "    #""Removed Other Columns"" = Table.SelectColumns(#""Changed Type"",{""Column2""})," & Chr(13) & "" & Chr(10) & _
        "    #""Filtered Rows"" = Table.SelectRows(#""Removed Other Columns"", each Text.StartsWith([Column2], ""FilterValue1""))" & Chr(13) & "" & Chr(10) & _
        "in" & Chr(13) & "" & Chr(10) & "    #""Filtered Rows"""
    
    '创建辅助查询
    ActiveWorkbook.Queries.Add Name:="Parameter1", Formula:= _
        "#""Sample File"" meta [IsParameterQuery=true, BinaryIdentifier=#""Sample File"", type=""Binary"", IsParameterQueryRequired=true]"
    
    ActiveWorkbook.Queries.Add Name:="Transform Sample File", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Excel.Workbook(Parameter1, null, true)," & Chr(13) & "" & Chr(10) & _
        "    Page1_Sheet = Source{[Item=""Page1"",Kind=""Sheet""]}[Data]," & Chr(13) & "" & Chr(10) & _
        "    #""Promoted Headers"" = Table.PromoteHeaders(Page1_Sheet, [PromoteAllScalars=true])" & Chr(13) & "" & Chr(10) & _
        "in" & Chr(13) & "" & Chr(10) & "    #""Promoted Headers"""
    
    ActiveWorkbook.Queries.Add Name:="Sample File", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Folder.Files(""" & SourcePath & """)," & Chr(13) & "" & Chr(10) & _
        "    Navigation1 = Source{0}[Content]" & Chr(13) & "" & Chr(10) & _
        "in" & Chr(13) & "" & Chr(10) & "    Navigation1"
    
    ActiveWorkbook.Queries.Add Name:="Transform File", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = (Parameter1) => let" & Chr(13) & "" & Chr(10) & _
        "        Source = Excel.Workbook(Parameter1, null, true)," & Chr(13) & "" & Chr(10) & _
        "        Page1_Sheet = Source{[Item=""Page1"",Kind=""Sheet""]}[Data]," & Chr(13) & "" & Chr(10) & _
        "        #""Promoted Headers"" = Table.PromoteHeaders(Page1_Sheet, [PromoteAllScalars=true])" & Chr(13) & "" & Chr(10) & _
        "    in" & Chr(13) & "" & Chr(10) & "        #""Promoted Headers""" & Chr(13) & "" & Chr(10) & _
        "in" & Chr(13) & "" & Chr(10) & "    Source"
    
    '添加查询到工作表，避免依赖ActiveSheet
    Set wsNew = ActiveWorkbook.Worksheets.Add
    With wsNew.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Data;Extended Properties=""""" _
        , Destination:=wsNew.Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Data]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Data"
        .Refresh BackgroundQuery:=False
    End With
    
    '重命名工作表
    wsNew.Name = "TEST1"
    
    '创建连接，使用ThisWorkbook避免硬编码
    ThisWorkbook.Connections.Add2 "Query - Parameter1", _
        "Connection To the 'Parameter1' query in the workbook.", _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Parameter1;Extended Properties=""""" _
        , "SELECT * FROM [Parameter1]", 2
    
    ThisWorkbook.Connections.Add2 "Query - Transform Sample File", _
        "Connection To the 'Transform Sample File' query in the workbook.", _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Transform Sample File"";Extended Properties=""""" _
        , "SELECT * FROM [Transform Sample File]", 2
    
    ThisWorkbook.Connections.Add2 "Query - Sample File", _
        "Connection To the 'Sample File' query in the workbook.", _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Sample File"";Extended Properties=""""" _
        , "SELECT * FROM [Sample File]", 2
    
    ThisWorkbook.Connections.Add2 "Query - Transform File", _
        "Connection To the 'Transform File' query in the workbook.", _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Transform File"";Extended Properties=""""" _
        , "SELECT * FROM [Transform File]", 2
    
    '复制工作表并保存
    wsNew.Copy
    ChDir SavePath
    ActiveWorkbook.SaveAs Filename:=SavePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
End Sub

关键修复点说明 #

1. 移除重复Sub定义：删除代码开头重复的Sub AddSaveQuery()，保证变量作用域正常
2. 修复PowerQuery公式：修正断裂的M语言片段，确保语法完整正确
3. 简化路径获取：单元格直接存储纯路径（如C:\Test），VBA拼接时自动添加双引号，无需用CONCAT额外处理
4. 替换硬编码工作簿名：用ThisWorkbook替代固定名称，适配工作簿重命名场景
5. 提前清理旧查询：添加错误处理，删除已存在的同名查询，避免重复添加报错
6. 指定操作工作表：用变量wsNew引用新建工作表，避免依赖ActiveSheet引发的对象错误
7. 移除无效连接操作：删除对Book1的连接创建代码，避免操作不存在的工作簿

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