通过VBA将目录中的所有XML文件转换为XLS

时间:2018-10-26 07:01:01

标签: excel xml vba xml-parsing converters

我的目录中大约有950个.xml文件。我可以使用Excel打开.xml文件,没有任何问题。但我想将所有文件分别转换为.xls(或.csv)。我在论坛上进行了搜索,找到了一些答案(例如,herehere),但到目前为止无法正常工作。

我最需要的是以下代码:

Sub xmltoxl()
    Dim f As String
    Dim wbk As Workbook
    Dim s As Integer
    Dim tBook As Workbook
    Dim MySht As Worksheet

    Set tBook = ThisWorkbook
    Set MySht = tBook.Sheets(1)
    MySht.Cells.ClearContents

    f = Dir("C:\Users\Kanye\Downloads" & "\*.xml")
    s = 0

    Do While Len(f) > 0
        Set wbk = Workbooks.OpenXML("C:\Users\Kanye\Downloads" & "\" & f)
        If s = 0 Then
           wbk.Sheets(1).Cells.Copy Destination:=MySht.Cells
           LastRow = MySht.Range("A" & Rows.Count).End(xlUp).Row
           MySht.Range("Z1:Z" & LastRow) = f
        Else
           LastRow = MySht.Range("A" & Rows.Count).End(xlUp).Row
           NextRow = LastRow + 1

           wbkLastRow = wbk.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

           wbk.Sheets(1).Rows("1:" & wbkLastRow).Copy Destination:=MySht.Rows(NextRow)

           NewLastRow = MySht.Range("A" & Rows.Count).End(xlUp).Row
           MySht.Range("Z" & NextRow & ":Z" & NewLastRow) = f
        End If
        MySht.Columns("Z").Cut
        MySht.Columns("A").Insert

        s = s + 1
        wbk.SaveAs Filename:="C:\Users\Kanye\Downloads\Test" & s & ".csv"
        wbk.Close False
        f = Dir()
    Loop

End Sub 

但是,当我运行它时,在目录中的第一个.xml打开后,我得到了一个错误。有关如何解决此问题的任何想法?

2 个答案:

答案 0 :(得分:4)

尝试此代码

Sub XMLTOCSV()
Dim f           As String
Dim p           As String
Dim s           As Integer

p = Environ("USERPROFILE") & "\Downloads" & "\"
f = Dir(p & "*.xml")
s = 0

Application.ScreenUpdating = False
    Do While Len(f) > 0
        s = s + 1
        ConvertXMLtoCSV p & f, p & "Test" & s & ".csv"
        f = Dir()
    Loop
Application.ScreenUpdating = True
End Sub

Sub ConvertXMLtoCSV(xmlFile, csvFile)
Dim xlApp       As Application
Dim xlBook      As Workbook

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.OpenXML(xmlFile, 2)
xlBook.SaveAs csvFile, 6
xlBook.Close False
xlApp.Quit
End Sub

答案 1 :(得分:2)

我发现Workbook.SaveAs的最有效方法是忽略任何扩展名,而让FileFormat参数为您选择扩展名。

...
wbk.SaveAs Filename:="C:\Users\Kanye\Downloads\Test" & s, fileformat:=xlcsv
wbk.Close savechanges:=False
...