vba to generate XML file with different values

[AA_20069]

Hi all,

As per the title. Is there anyway to have an excel spreadsheet as the datafile and then from that to create multiple xml files each one populated with the data. So this would create 4 xml files (nams of then can be identifed with 1,2,3,4 etc)

Any help would be good.


<NAME>






<Firstname></firstname>
Mark
Peter
Carol
Jack


<surname></surname>
Richads
Simon
Jane
Peters


<middlename></middlename>
Jeff
Blue
Mary
Paul


</name>

[Jan Karel Pieterse]

Assuming your data is in A:D like so:



Mark
Richads
Jeff


Peter
Simon
Blue


Carol
Jane
Mary


Jack
Peters
Paul





Sub GenerateXMLFiles()
Dim ocell As Range
Dim sXML As String
Dim lFile As Long
Dim lCount As Long
For Each ocell In ActiveSheet.UsedRange.Columns(1).Cells
lCount = lCount + 1
sXML = "<?xml version=""1.0""?>"
sXML = sXML & vbNewLine & "<Name>" & vbNewLine & "<Firstname>" & ocell.Value & "</Firstname>"
sXML = sXML & vbNewLine & "<Surname>" & ocell.Offset(, 1).Value & "</Surname>"
sXML = sXML & vbNewLine & "<Middlename>" & ocell.Offset(, 2).Value & "</Middlename>"
sXML = sXML & vbNewLine & "</Name>"
lFile = FreeFile
Open "xml file " & lCount & ".xml" For Output As lFile
Print #lFile, sXML
Close lFile
Next
End Sub

[AA_20069]

Assuming your data is in A:D like so:



Mark

Richads

Jeff



Peter

Simon

Blue



Carol

Jane

Mary



Jack

Peters

Paul






Sub GenerateXMLFiles()
Dim ocell As Range
Dim sXML As String
Dim lFile As Long
Dim lCount As Long
For Each ocell In ActiveSheet.UsedRange.Columns(1).Cells
lCount = lCount + 1
sXML = "<?xml version=""1.0""?>"
sXML = sXML & vbNewLine & "<Name>" & vbNewLine & "<Firstname>" & ocell.Value & "</Firstname>"
sXML = sXML & vbNewLine & "<Surname>" & ocell.Offset(, 1).Value & "</Surname>"
sXML = sXML & vbNewLine & "<Middlename>" & ocell.Offset(, 2).Value & "</Middlename>"
sXML = sXML & vbNewLine & "</Name>"
lFile = FreeFile
Open "xml file " & lCount & ".xml" For Output As lFile
Print #lFile, sXML
Close lFile
Next
End Sub



:bow:

Thanks

[snb]

or

Sub M_snb()
sn = Filter([transpose(if(A1:A100="","","<?xml version=""1.0""?><Name><Firstname>"&a1:A100&"</Firstname><Surname>"&B1:B100&"</Surname><Middlename>"&C1:C100&"</Middlename></Name>"))], "<")

With CreateObject("scripting.filesystemobject")
For j = 0 To UBound(sn)
.createtextfile("G:\OF\xml_" & Format(j, "000") & ".xml").write Replace(sn(j), "><", ">" & vbLf & "<")
Next
End With
End Sub