Excel VBA宏导入XML表格报错：路径或文件名定义问题排查

核心错误点 #

1. 未过滤XML文件
   代码遍历目录下所有文件，包括当前Excel文件本身、非XML格式文件，这类文件无法被Xml.Tables解析，直接触发"文件名或路径定义不正确"的错误。

2. 查询名称重复
   每次循环都创建名为Letture_canali的Power Query查询，第二次循环时因查询已存在，会导致后续操作失败。

3. OLEDB连接字符串语法错误
   原代码中Source参数的字符串末尾存在多余的引号和空格，导致连接格式非法。

4. 工作表命名冲突风险
   仅用Foglio+数字命名，若已有同名工作表，会触发创建失败的错误。

修正后的代码 #

Sub Vai()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim percorso As String
    Dim n As Integer
    Dim queryName As String
    Dim wsName As String

    n = 2
    Set fso = CreateObject("scripting.Filesystemobject")
    Set folder = fso.GetFolder(ThisWorkbook.Path)

    For Each file In folder.Files
        ' 仅处理XML文件
        If LCase(fso.GetExtensionName(file.Path)) = "xml" Then
            percorso = file.Path
            wsName = "Foglio" & n
            ' 检查工作表是否存在，避免命名冲突
            On Error Resume Next
            If Not Worksheets(wsName) Is Nothing Then
                wsName = wsName & "_" & Format(Now(), "HHmmss")
            End If
            On Error GoTo 0
            Sheets.Add.Name = wsName

            ' 生成唯一的查询名称
            queryName = "Letture_canali_" & n
            
            ' 创建Power Query查询
            ActiveWorkbook.Queries.Add Name:=queryName, Formula:= _
                "let" & Chr(13) & "" & Chr(10) & _
                "    Origine = Xml.Tables(File.Contents(""" & percorso & """))," & Chr(13) & "" & Chr(10) & _
                "    Table0 = Origine{0}[Table]," & Chr(13) & "" & Chr(10) & _
                "    #""Modificato tipo"" = Table.TransformColumnTypes(Table0,{{""index"", Int64.Type}, {""ch1"", Int64.Type}, {""ch2"", Int64.Type}, {""ch3"", Int64.Type}, {""ch4"", Int64.Type}, {""encoder1"", Int64.Type}, {""encoder2"", Int64.Type}, {""tempo"", Int64.Type}})" & Chr(13) & "" & Chr(10) & _
                "in" & Chr(13) & "" & Chr(10) & "    #""Modificato tipo"""
            
            ' 修正OLEDB连接字符串，添加正确的闭合引号
            With Worksheets(wsName).ListObjects.Add(SourceType:=0, Source:= _
                "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & queryName & ";Extended Properties=""""" _
                , Destination:=Range("$A$1")).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 = queryName
                .Refresh BackgroundQuery:=False
            End With

            n = n + 1
        End If
    Next

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

关键修正说明 #

• 过滤XML文件：通过fso.GetExtensionName判断文件后缀，仅处理.xml文件。
• 唯一查询名称：在查询名后添加数字后缀，避免重复创建查询。
• 修复连接字符串：修正OLEDB连接字符串的语法错误，确保格式合法。
• 避免工作表命名冲突：检查目标工作表是否存在，若存在则添加时间戳后缀。

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