Question

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

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

Do While Len(f) > 0
    s = s + 1
    Set wbk = Workbooks.OpenXML("C:\Users\Kanye\Downloads" & "\" & f)
wbk.SaveAs Filename:="C:\Users\Kanye\Downloads\Test" & s & ".csv"
wbk.Close False
f = Dir()
Loop

End Sub

我有900个XML文件。此代码采用一个XML文件并将其转换为一个CSV。有没有办法将其转换为一个总CSV？

我尝试以下过程，但打开时数据已损坏（我收到此错误：http://imgur.com/SiyiGag）

cd /Users/kanye/Desktop/XML/unzipped
copy *.csv newfile.csv

这最终会给我这样的数据http://imgur.com/zK0R2UT

Answer 1

看看这是否有效。没有测试它，但之前很多次使用这样的代码。

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

VBA将XML文件转换为一个CSV

1 个答案: