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