通过 VBA 将目录中的所有 XML 文件转换为 XLS
Convert all XML files in a directory to XLS via VBA
我在一个目录中有大约 950 个 .xml
文件。我可以使用 Excel 打开 .xml
文件而没有任何问题。但我想将所有文件单独转换为 .xls
(或 .csv
)。我搜索了论坛并找到了一些答案(参见 here and ),但到目前为止无法正常工作。
最接近我需要的是以下代码:
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
后返回错误。关于如何解决这个问题的任何想法?
我找到了最有效的Workbook.SaveAs is to ignore any extension and let the FileFormat参数方法,为您选择。
...
wbk.SaveAs Filename:="C:\Users\Kanye\Downloads\Test" & s, fileformat:=xlcsv
wbk.Close savechanges:=False
...
试试这个代码
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
我在一个目录中有大约 950 个 .xml
文件。我可以使用 Excel 打开 .xml
文件而没有任何问题。但我想将所有文件单独转换为 .xls
(或 .csv
)。我搜索了论坛并找到了一些答案(参见 here and
最接近我需要的是以下代码:
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
后返回错误。关于如何解决这个问题的任何想法?
我找到了最有效的Workbook.SaveAs is to ignore any extension and let the FileFormat参数方法,为您选择。
...
wbk.SaveAs Filename:="C:\Users\Kanye\Downloads\Test" & s, fileformat:=xlcsv
wbk.Close savechanges:=False
...
试试这个代码
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