Excel VBA查询用变量指定文件路径时出现运行时错误1004的排查

问题背景 #

录制查询桌面文件的宏后，添加FilePath变量通过Application.GetOpenFilename()让用户选择文件路径，修改后的宏运行时出现运行时错误1004-应用程序定义或对象定义错误。

错误原因 #

1. Power Query路径字符串未正确转义
   原代码拼接文件路径时使用"" & FilePath & ""，导致Power Query公式里的文件路径没有被正确的双引号包裹，Power Query无法识别合法路径，触发语法错误。

2. 未处理用户取消选择的情况
   Application.GetOpenFilename()在用户取消选择时会返回布尔值False而非字符串，此时将False拼接到公式中会导致类型不匹配错误。

3. WSData对象未定义
   如果WSData没有被声明为工作表对象并赋值（比如Set WSData = ThisWorkbook.Worksheets("目标工作表名")），调用WSData.ListObjects.Add时会因对象引用无效报错。

4. 重复添加同名查询
   若工作簿中已存在名为Sheet1的查询，再次调用ActiveWorkbook.Queries.Add会因重名触发错误。

修复后的完整代码 #

Sub Macro3()
    Dim FilePath As Variant ' 用Variant接收，兼容取消选择时返回的布尔值
    Dim ws As Worksheet
    Dim existingQuery As WorkbookQuery
    
    ' 定义目标工作表，替换为实际需要的工作表名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 让用户选择文件，取消则直接退出宏
    FilePath = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xlsx;*.xls), *.xlsx;*.xls", Title:="选择要导入的Excel文件")
    If FilePath = False Then Exit Sub
    
    ' 检查是否存在同名查询，存在则删除
    On Error Resume Next
    Set existingQuery = ActiveWorkbook.Queries("Sheet1")
    On Error GoTo 0
    If Not existingQuery Is Nothing Then
        existingQuery.Delete
    End If
    
    ' 添加Power Query查询，正确转义文件路径
    ActiveWorkbook.Queries.Add Name:="Sheet1", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Excel.Workbook(File.Contents(""" & FilePath & """), null, true)," & Chr(13) & "" & Chr(10) & "    Sheet1_Sheet = Source{[Item=""Sheet1"",Kind=""Sheet""]}[Data]," & Chr(13) & "" & Chr(10) & "    #""Promoted Headers"" = Table.PromoteHeaders(Sheet1_Sheet, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformCol" & _
        "umnTypes(#""Promoted Headers"",{{""Column1"", type any}, {""Column2"", type any}, {""Column3"", type any}, {""Column4"", type any}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & "    #""Changed Type"""
    
    ' 创建ListObject并刷新数据
    With ws.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Sheet1;Extended Properties=""""""" _
        , Destination:=ws.Range("$A$11")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Sheet1]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Sheet1"
        .Refresh BackgroundQuery:=False
    End With
End Sub

关键修复点说明 #

• 将FilePath声明为Variant类型，兼容用户取消选择时返回的布尔值；
• 添加用户取消选择的判断逻辑，避免无效值进入后续代码；
• 用"""" & FilePath & """"正确转义路径，确保Power Query公式中路径被双引号包裹；
• 显式定义目标工作表ws，替换原代码中未定义的WSData；
• 添加查询重名检查，删除已存在的同名查询，避免重复添加报错。

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