ใช้ excel สร้าง csv file จาก xml file

เป็นการสร้าง csv file จาก xml หลายๆ file ที่อยู่ใน folder ที่กำหนด โดยสามารถเปลี่ยน folder ได้ที่ change path และภายใต้ folder นี้เป็น xml ...

เป็นการสร้าง csv file จาก xml หลายๆ file ที่อยู่ใน folder ที่กำหนด โดยสามารถเปลี่ยน folder ได้ที่ change path และภายใต้ folder นี้เป็น xml file ทั้งหมด

ที่ผมใช้จะเป็น option 2 ทั้ง 2 อันนี้ copy มา แต่ลองใช้อันที่ 2 แล้วใช้ได้ ก็เลยใช้อันนี้ตลอด

การนำไปใช้: ให้ enable Development menu ของ excel ก่อน แล้วคลิ๊กที่ Visual Basic ดังรูป

หลังจากนั้นก็ให้ double click ที่ ThisWorkbook จะมีหน้าต่างใหม่ปรากฏขึ้นแล้วให้ copy code จะเป็น option 1 หรือ 2 แล้วแต่จะเลือก จากนั้นก็กดปุ่ม RUN ปุ่มสามเหลี่ยมด้านบน เสร็จแล้วนั่งรอ อาจใช้เวลามากน้อยขึ้นอยู่กับขนาดของ xml file และจำนวน ปรกติที่ผมทำก็รอหลายสิบนาทีอยู่ครับ แต่ xml file ประมาณ 100 ขนาด file ก็น่าจะประมาณ 1000 บรรทัด 4-5 row ผมก็เรียกไม่ถูกน๊ะครับ แต่ให้รอเถอะ ถ้า xml file ไม่มีปัญหาอะไร รอซักพักก็จะได้ csv file หนึ่งไฟล์ที่รวมทุกๆ xml file มาให้แล้ว

Option 1

import all xml files without xml maps in a new sheet named: append-data

Sub Load_XML_files()
Const sName$ = "append-data"
Dim wb As Workbook, wb1 As Workbook
Set wb = ThisWorkbook
Dim newSht As Worksheet, sh As Worksheet
Dim sPath
sPath = "C:\temp\xml\" '<< change path
Dim sFile
Dim L As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each sh In wb.Worksheets
If sh.Name = sName Then sh.Delete
Next
Set newSht = wb.Sheets.Add
newSht.Name = sName
sFile = Dir(sPath & "*.xml")
L = 1
Do Until sFile = ""
Set wb1 = Workbooks.OpenXML(Filename:=sPath & sFile, LoadOption:=xlXmlLoadImportToList)
With newSht
wb1.Sheets(1).UsedRange.Copy .Cells(L, 1)
wb1.Close False
.ListObjects(1).Range.AutoFilter
.ListObjects(1).Unlist
If L > 1 Then .Cells(L, 1).EntireRow.Delete
L = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End With
sFile = Dir()
Loop
newSht.Range("A1").CurrentRegion.Interior.Pattern = xlNone
newSht.ListObjects.Add(xlSrcRange, newSht.Range("A1").CurrentRegion, , xlYes).Name = "Tbl_01"
wb.Save
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

----------------------------------------------------------------------------------------

Option 2

import all xml files with xml maps in a new sheet named: append-data

Sub Load_XML_filesMap()
 Const sName$ = "append-data"
 Dim wb As Workbook
 Set wb = ThisWorkbook
 Dim newSht As Worksheet, sh As Worksheet
 Dim sPath
 sPath = "C:\temp\xml\" '<< change path
 Dim sFile
 Dim L As Long
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 For Each sh In wb.Worksheets
 If sh.Name = sName Then sh.Delete
 Next
 Set newSht = wb.Sheets.Add
 newSht.Name = sName

'

 'delete old XMLMaps ###
Dim obj As XmlMap
For Each obj In ActiveWorkbook.XmlMaps
obj.Delete
Next obj
' ###

'

 sFile = Dir(sPath & "*.xml")
 L = 1
 Do Until sFile = ""
ActiveWorkbook.XmlImport URL:=sPath & sFile, ImportMap:=Nothing, Overwrite:=True, Destination:=newSht.Cells(L, 1)
L = newSht.Cells(Rows.Count, 1).End(xlUp).Row + 2
 sFile = Dir()
 Loop
 wb.Save
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True
 End Sub