Листинг 1
Преобразование объекта Recordset в объект DOMDocument,
а затем сохранение его в виде XML-файла
Public Sub ExportXML(rs As Recordset, strHeading$, FileName$)
' Экспорт таблицы RecordSet в XML файл
Dim xmlDoc As DOMDocument
' Cоздаем XMLDOM-объект
Set xmlDoc = RecordsetToXMLDOM(rs, strHeading$)
' выводим его в виде отдельного файла
xmlDoc.Save FileName$
End Sub
Public Function RecordsetToXMLDOM(rs As Recordset, strHeading$) As DOMDocument
'
' Преобразование Recordset в DOMDocument
'
Dim fldField As Field
Dim xmlDoc As DOMDocument
Dim xmlFields As IXMLDOMElement
Dim xmlField As IXMLDOMElement
Dim i&
' создание экземпляра объекта
Set xmlDoc = CreateObject("Microsoft.XMLDOM") ' New DOMDocument
' записываем XML-константу объекта
xmlDoc.loadXML "<?xml version='1.0'?>" + _
Replace("<" + strHeading + "/>", " ", "_")
With rs
' Вывод содержимого полей таблицы
.MoveFirst: i=1
Do Until .EOF
' создание нового узла
Set xmlFields = xmlDoc.documentElement.appendChild _
(xmlDoc.createElement("OneRow" +LtRim(Str(i))))
For Each fldField In rs.Fields ' запись полей записи
Set xmlField = xmlFields.appendChild( _
xmlDoc.createElement(Replace(fldField.Name, " ", "_")))
xmlField.Text = fldField.Value
Next
.MoveNext ' к следующей записи набора
i = i + 1
Loop
End With
Set RecordsetToXMLDOM = xmlDoc ' возвращаем созданный объект
End Function