Советы тем, кто программирует на VB & VBA
Листинг 1. Вывод XML-данных в виде элементов и атрибутов
Dim xmlDoc As DOMDocument
Public Sub Main()
' Cоздание экземпляра объекта
' xmlDoc — переменная уровня модуля!
Set xmlDoc = New DOMDocument
' записываем XML-константу объекта
xmlDoc.loadXML "<?xml version='1.0'" & _
"encoding='Windows-1251'?>" & _
"<ОписаниеКонтактов/>"
' Создание узла "ВариантАтрибуты"
Call CreateNewNode("ВариантАтрибуты", True)
' Создание узла "ВариантАтрибуты"
Call CreateNewNode("ВариантЭлементы", False)
'
xmlDoc.Save "d:\file2.xml"
End Sub
Public Sub AddContactInfomation( _
varAttrNode As IXMLDOMElement, FirstName$, _
Birthdate As Date, Height As Single, VarType As Boolean)
Dim xmlField As IXMLDOMElement
'
' создание нового подчиненного узла
Set xmlField = varAttrNode.appendChild _
(xmlDoc.createElement("Контакт"))
' запись информации
Call addData(xmlField, "Имя", FirstName$, VarType)
Call addData(xmlField, "ДатаРождения", Birthdate, VarType)
Call addData(xmlField, "Рост", Height, VarType)
End Sub
Public Sub addData(xmlField As IXMLDOMElement, _
dName$, dValue As Variant, VarType As Boolean)
' добавить атрибут для узла
Dim attr As IXMLDOMAttribute
Dim xmlData As IXMLDOMElement
'
If VarType Then ' "ВариантАтрибуты"
Set attr = xmlDoc.createAttribute(dName)
attr.Value = dValue
xmlField.Attributes.setNamedItem attr
Else
Set xmlData = xmlField.appendChild _
(xmlDoc.createElement(dName))
xmlData.Text = dValue
End If
End Sub
Public Sub CreateNewNode(NodeName$, VarType As Boolean)
' Создание одного узла и запись в него информации
' VarType = True (в виде атрибутов)
' = False (в виде элементов)
Dim NewNode As IXMLDOMElement
' Создание узла "ВариантЭлементы"
Set NewNode = xmlDoc.documentElement.appendChild _
(xmlDoc.createElement(NodeName))
' запись информации в виде атрибутов
Call AddContactInfomation(NewNode, "Ирина", _
"20.09.1953", 1.65, VarType)
Call AddContactInfomation(NewNode, "Ольга", _
"17.08.1958", 1.63, VarType)
End Sub
