Question

我使用下面的代码将多个xml文件导入excel。代码工作正常。我面临的唯一问题是，它不是作为XML表导入到Excel。我想将它们作为表导入，以便使用此数据进行进一步处理。

Sub XMLtoExcel()
    Dim xWb As Workbook
    Dim xSWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xCount As Long
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Application.ScreenUpdating = False
    Set xSWb = ThisWorkbook
    xCount = 1
    xFile = Dir(xStrPath & "\*.xml")
    Do While xFile <> ""
        Set xWb = Workbooks.OpenXML(xStrPath & "\" & xFile)
        xWb.Sheets(1).UsedRange.Copy xSWb.Sheets(1).Cells(xCount, 1)
        xWb.Close False
        xCount = xSWb.Sheets(1).UsedRange.Rows.Count + 2
        xFile = Dir()
    Loop
    Application.ScreenUpdating = True
    xSWb.Save
    Exit Sub
End Sub

任何人都可以提示我这样做吗？

Answer 1

Sub XMLtoExcel()
    Dim xWb As Workbook
    Dim xSWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xCount As Long

    Dim myURL As String
    Dim n As Long


    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Application.ScreenUpdating = False
    Set xSWb = ThisWorkbook

    xFile = Dir(xStrPath & "\*.xml")
    Do While xFile <> ""
        n = n + 1
        If n = 1 Then
            Set xWb = Workbooks.OpenXML(xStrPath & "\" & xFile)
        Else
            myURL = xStrPath & "\" & xFile
            ImportToxml myURL, xWb
        End If
        xFile = Dir()
    Loop
    xSWb.Sheets(1).UsedRange.Clear
    xWb.Sheets(1).UsedRange.Copy xSWb.Sheets(1).Cells(1, 1)
    xWb.Close False
    Application.ScreenUpdating = True
    xSWb.Save
    Exit Sub
End Sub
Sub ImportToxml(myURL As String, Wb As Workbook)

    Dim myMap As XmlMap
    Set myMap = Wb.XmlMaps(1)
        myMap.Import URL:=myURL, Overwrite:=False

End Sub

如果您的工作簿具有相同的xml映射，代码会像这样改变

Sub XMLtoExcel()
    Dim xWb As Workbook
    Dim xSWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xCount As Long

    Dim myURL As String
    Dim n As Long


    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Application.ScreenUpdating = False
    Set xSWb = ThisWorkbook

    xFile = Dir(xStrPath & "\*.xml")
    Do While xFile <> ""
            myURL = xStrPath & "\" & xFile
            ImportToxml myURL, xSWb

        xFile = Dir()
    Loop
    xWb.Save
    Application.ScreenUpdating = True

    Exit Sub
End Sub
Sub ImportToxml(myURL As String, Wb As Workbook)

    Dim myMap As XmlMap
    Set myMap = Wb.XmlMaps(1)
        myMap.Import URL:=myURL, Overwrite:=False

End Sub

将多个XML作为Excel表导入Excel

1 个答案: