Sub Convert_Excel_Data_to_XML()
Dim doc As MSXML2.DOMDocument60
Dim rng As Range, rngRow As Range
Dim root As MSXML2.IXMLDOMElement
Dim child As MSXML2.IXMLDOMElement
Dim xmlDecl As MSXML2.IXMLDOMProcessingInstruction
Dim sXmlFilePath As String
Set doc = New MSXML2.DOMDocument60
sXmlFilePath = ThisWorkbook.Path & "\Output.xml"
Set xmlDecl = doc.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
doc.appendChild xmlDecl
Set root = doc.createElement("Города")
root.setAttribute "xmlns:xs", "type"
doc.appendChild root
On Error Resume Next
Set rng = Range(Range("a2"), Range("a" & Rows.Count).End(xlUp)).Resize(, 4)
Dim cities As New Collection, streets As New Collection
Dim city_node As MSXML2.IXMLDOMElement, street_node As MSXML2.IXMLDOMElement, city$, street$
For Each rngRow In rng.Rows
city$ = rngRow.Cells(1): street$ = rngRow.Cells(2)
Err.Clear: cities.Add city$, city$
If Err = 0 Then Set city_node = root.appendChild(doc.createElement(city$)): Set streets = New Collection
Err.Clear: streets.Add street$, street$
If Err = 0 Then Set street_node = city_node.appendChild(doc.createElement(street$))
With street_node.appendChild(doc.createElement("Дом"))
.Attributes.setNamedItem(doc.createAttribute("id")).Text = rngRow.Cells(3)
.Attributes.setNamedItem(doc.createAttribute("Квартира")).Text = rngRow.Cells(4)
End With
Next
doc.Save sXmlFilePath
Debug.Print sXmlFilePath
End Sub
