Excel Data to XML



需要将excel数据转换为XML格式。

'vba code to convert excel to xml
Sub vba_code_to_convert_excel_to_xml()
Set wb = Workbooks.Open("C:temptestwb.xlsx")
wb.SaveAs fileName:="C:temptestX.xml", FileFormat:= _
xlXMLSpreadsheet, ReadOnlyRecommended:=False, CreateBackup:=False

请告诉我如何在VBA中做到这一点,或者提供一个我可以参考的链接。提前感谢。

对于一个简单的例子,一种方法是逐行构建xml

Sub vba_code_to_convert_excel_to_xml2()
Const FOLDER = "C:temp"
Const XLS_FILE = "testwb.xlsx"
Const XML_FILE = "testX.xml"
Const XML = "<?xml version=""1.0"" encoding=""utf-8""?>" & vbCrLf & _
"<Core-Information ContextID=""Context1"" WorkspaceID=""Main"">" & vbCrLf & _
"  <UserList>" & vbCrLf

Dim wb As Workbook, ws As Worksheet, ar, s As String
Dim iLastRow As Long, r As Long, n As Integer
' open source workbook
Set wb = Workbooks.Open(FOLDER & XLS_FILE, 1, 1)
Set ws = wb.Sheets("Sheet1")
iLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
' create XML document
'<User ID="Aravind" ForceAuthentication="false" Password="1234" EMail="Aravind@gmail.com">
'    <Name>Aravind</Name>
'    <UserGroupLink UserGroupID="Sports"/>
'</User>
s = XML
For r = 2 To iLastRow
s = s & "    <User ID=""" & ws.Cells(r, 1) & """" & _
" ForceAuthentication=""false"" Password=""" & ws.Cells(r, 2) & """" & _
" EMail=""" & ws.Cells(r, 3) & """>" & vbCrLf
s = s & "      <Name>" & ws.Cells(r, 1) & "</Name>" & vbCrLf

ar = Split(ws.Cells(r, 4), ",")
For n = LBound(ar) To UBound(ar)
s = s & "      <UserGroupLink UserGroupID=""" & Trim(ar(n)) & """/>" & vbCrLf
Next
s = s & "    </User>" & vbCrLf
Next
s = s & "  </UserList>" & vbCrLf & "</Core-Information>"

' save
Dim fso, ts
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.createtextfile(FOLDER & XML_FILE)
ts.write s
ts.Close
MsgBox "Xml created to " & FOLDER & XML_FILE
End Sub

最新更新