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' encoding='windows-1251' ?>" + _
      Replace("<" + strHeading + "/>", " ", "_")
       ' '
      
   With rs
          ' создание нового узла1
          Set xmlFields1 = xmlDoc.DocumentElement.appendChild _
            (xmlDoc.createElement("ПлатежныеПоручения"))
 
   End With
   With rs
      ' Вывод содержимого полей таблицы
      .MoveFirst: i = 1
       Do Until .EOF
          ' создание нового узла3
          Set xmlFields = xmlFields1.appendChild _
            (xmlDoc.createElement("R"))
 
          For Each fldField In rs.Fields   ' запись полей записи
            If IsNull(fldField) = True Then
            Else
                Set xmlField = xmlFields.appendChild( _
                xmlDoc.createElement(Replace(fldField.Name, " ", "_")))
                xmlField.Text = fldField.Value
            End If
          Next
         .MoveNext   ' к следующей записи набора
          i = i + 1
      Loop
   End With
   Set RecordsetToXMLDOM = xmlDoc   ' возвращаем созданный объект
End Function
Private Sub ЭкспортУРМ_Click()
Dim strConnectString$, strSQL$, strHeading$
    strHeading = "KristaExchange"
   
    Dim rs As Recordset
    Dim MyDB As Database
    Dim MySQL As Variant
    
    Set MyDB = CurrentDb
    MySQL = "SELECT * FROM Caption_OUT"
    Set rs = MyDB.OpenRecordset(MySQL)
   
   Call ExportXML(rs, strHeading$, "d:\xml\file1.xml")
   
End Sub
 

<?xml version="1.0" encoding="UTF-8"?>
<UFormatAPK>
	<!-- Otchetnost APK. Configuratsiya:1.1.1.9, Model:4q02 -->
	<Org>
		<Code></Code>
		<Name>ИП Глава КФХ Бабин В.А.</Name>
		<FullName>ИП Глава КФХ Бабин В.А.</FullName>
		<SuperiorOrg>6317</SuperiorOrg>
		<DateOfRegistration>2004-12-24</DateOfRegistration>
		<INN>637700150240</INN>
		<KPP>0</KPP>
		<OKPO>14324069</OKPO>
		<OPF></OPF>
		<OKOPF>53</OKOPF>
		<OGRN>304637735900052</OGRN>
		<ActivityForm>1</ActivityForm>
		<OKVEDorOKONH>01.11.11,</OKVEDorOKONH>
		<OKATO>36230820000</OKATO>
		<GeneralManager>ФИО</GeneralManager>
		<MainAccountant></MainAccountant>
		<Executor>ФИО</Executor>
		<Address></Address>
		<ContactData></ContactData>
		<OKFS>16</OKFS>
		<OKER></OKER>
		<OKTMO>36630420</OKTMO>
		<OPForg>ipkh</OPForg>
		<SysNalog>usn</SysNalog>
		<Property1></Property1>
		<Property2></Property2>
		<Property3></Property3>
		<Property4></Property4>
		<Property5></Property5>
		<Form10FPK>Форма10фер</Form10FPK>
		<Account>
			<Report>
				<CodeOfReport>f10af</CodeOfReport>
				<Period>0_2016</Period>
				<parameter Code="парДатаОтчета"	Value=""/>
				<parameter Code="парДатаУтверждения"	Value=""/>
				<parameter Code="парДатаОтправки"	Value=""/>
				<parameter Code="парДатаПодписи"	Value="2017-01-25"/>
				<index String="065" Column="9" Value="48,639"/>
				<index String="065" Column="8" Value="113,491"/>
				<index String="065" Column="14" Value="0"/>
				<index String="065" Column="13" Value="-48,639"/>
				<index String="065" Column="12" Value="-113"/>
				<index String="065" Column="10" Value="0"/>
				<index String="065" Column="19" Value="113,491"/>

			</Report>
		</Account>
	</Org>

	</UFormatAPK>

Option Compare Database
Dim rs1, rs2

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' encoding='UTF-8'?>" + _
      Replace("<" + strHeading + "/>", " ", "_")

  With rs
       'Вывод содержимого полей таблицы
      .MoveFirst: i = 1
       Do Until .EOF
          ' создание нового узла3
       Set xmlFields1 = xmlDoc.DocumentElement.appendChild _
           (xmlDoc.createElement("ORG"))

          For Each fldField In rs.Fields   ' запись полей записи
            If IsNull(fldField) = True Then
            Else
                Set xmlField = xmlFields1.appendChild( _
                xmlDoc.createElement(Replace(fldField.Name, " ", "_")))
                xmlField.Text = fldField.Value
            End If
          Next
         .MoveNext   ' к следующей записи набора
          i = i + 1
      Loop
   End With
            
        Set xmlFields2 = xmlFields1.appendChild _
            (xmlDoc.createElement("Account"))
Set xmlFields3 = xmlFields2.appendChild _
           (xmlDoc.createElement("Report"))
Set rs1 = CurrentDb.OpenRecordset("SELECT distinct CodeReport, Period FROM Caption_OUT1")
  With rs1
       'Вывод содержимого полей таблицы
      .MoveFirst: i = 1
       Do Until .EOF
          ' создание нового узла3

          For Each fldField In rs1.Fields   ' запись полей записи
            If IsNull(fldField) = True Then
            Else
                Set xmlField = xmlFields3.appendChild( _
                xmlDoc.createElement(Replace(fldField.Name, " ", "_")))
                xmlField.Text = fldField.Value
            End If
          Next
         .MoveNext   ' к следующей записи набора
          i = i + 1
      Loop
   End With
Set rs2 = CurrentDb.OpenRecordset("SELECT Caption_OUT1.* FROM Caption_OUT1")
  With rs2
       'Вывод содержимого полей таблицы
      .MoveFirst: i = 1
       Do Until .EOF
          ' создание нового узла3

          For Each fldField In rs2.Fields   ' запись полей записи
            If IsNull(fldField) = True Then
            Else
                Set xmlField = xmlFields3.appendChild( _
                xmlDoc.createElement(Replace(fldField.Name, " ", "_")))
                xmlField.Text = fldField.Value
            End If
          Next
         .MoveNext   ' к следующей записи набора
          i = i + 1
      Loop
   End With
   Set RecordsetToXMLDOM = xmlDoc   ' возвращаем созданный объект
End Function
Private Sub выгрузить_Click()
Dim strConnectString$, strSQL$, strHeading$
    strHeading = "UFormatAPK"

    Dim rs As Recordset
    Dim rs1 As Recordset
    Dim MySQL As Variant
    Dim MySQL1 As Variant
    Set MyDB = CurrentDb
    MySQL = "SELECT * FROM Caption_OUT"
    MySQL1 = "SELECT Caption_OUT1.* FROM Caption_OUT1"
    Set rs = MyDB.OpenRecordset(MySQL)
    Set rs1 = MyDB.OpenRecordset(MySQL1)
    
   Call ExportXML(rs, strHeading$, "d:\xml\file1.xml")

End Sub

<parameter Code="парДатаПодписи"	Value="2017-01-25"/>
				<index String="065" Column="9" Value="48,639"/>
				<index String="065" Column="8" Value="113,491"/>
				<index String="065" Column="14" Value="0"/>
				<index String="065" Column="13" Value="-48,639"/>
				<index String="065" Column="12" Value="-113"/>
				<index String="065" Column="10" Value="0"/>
				<index String="065" Column="19" Value="113,491"/>

	<!-- Otchetnost APK. Configuratsiya:1.1.1.9, Model:4q02 -->

Public Sub CreateXML()
Dim ff As Integer
Dim rs As DAO.Recordset

ff = FreeFile 'дескриптор файла
Set rs = CurrentDb.OpenRecordset("select * from tab1") 'твой запрос к исходной таблице
Open "G:\testXML.xml" For Output As #ff 'открываем файло
Print #ff, "<Сеанс>" 'пишем заголовок

While Not rs.EOF
Print #ff, "<Субъект Тип=" & Chr(34) & "Предп_орг" & Chr(34) & " Код = " & rs![Names] & ">"
'chr(34)- это кавычки
'бла-бла в том-же духе
Print #ff, "<ГруппыОбъекта>" 'то, что тебе надо добавить в XML-файл
Print #ff, "<ГруппаОбъекта>"
'бла-бла в том-же духе
Print #ff, "</Субъект>"
rs.MoveNext
Wend

Print #ff, "</Сеанс>"

Close #ff
rs.Close
Set rs = Nothing

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' encoding='UTF-8'?>" + _
      Replace("<" + strHeading + "/>", " ", "_")
  With rs
       '&#194;&#251;&#226;&#238;&#228; &#241;&#238;&#228;&#229;&#240;&#230;&#232;&#236;&#238;&#227;&#238; &#239;&#238;&#235;&#229;&#233; &#242;&#224;&#225;&#235;&#232;&#246;&#251;
      .MoveFirst: i = 1
       Do Until .EOF
          ' &#241;&#238;&#231;&#228;&#224;&#237;&#232;&#229; &#237;&#238;&#226;&#238;&#227;&#238; &#243;&#231;&#235;&#224;3
       Set xmlFields1 = xmlDoc.DocumentElement.appendChild _
           (xmlDoc.createElement("ORG"))

          For Each fldField In rs.Fields   ' &#231;&#224;&#239;&#232;&#241;&#252; &#239;&#238;&#235;&#229;&#233; &#231;&#224;&#239;&#232;&#241;&#232;
            If IsNull(fldField) = True Then
            Else
                Set xmlField = xmlFields1.appendChild( _
                xmlDoc.createElement(Replace(fldField.Name, " ", "_")))
                xmlField.Text = fldField.Value
            End If
          Next
         .MoveNext   ' &#234; &#241;&#235;&#229;&#228;&#243;&#254;&#249;&#229;&#233; &#231;&#224;&#239;&#232;&#241;&#232; &#237;&#224;&#225;&#238;&#240;&#224;
          i = i + 1
      Loop
   End With
            
        Set xmlFields2 = xmlFields1.appendChild _
            (xmlDoc.createElement("Account"))
Set xmlFields3 = xmlFields2.appendChild _
           (xmlDoc.createElement("Report"))
Set rs1 = CurrentDb.OpenRecordset("SELECT distinct CodeReport, Period, Code FROM Caption_OUT1")
  With rs1
       '&#194;&#251;&#226;&#238;&#228; &#241;&#238;&#228;&#229;&#240;&#230;&#232;&#236;&#238;&#227;&#238; &#239;&#238;&#235;&#229;&#233; &#242;&#224;&#225;&#235;&#232;&#246;&#251;
      .MoveFirst: i = 1
       Do Until .EOF
          ' &#241;&#238;&#231;&#228;&#224;&#237;&#232;&#229; &#237;&#238;&#226;&#238;&#227;&#238; &#243;&#231;&#235;&#224;3

          For Each fldField In rs1.Fields   ' &#231;&#224;&#239;&#232;&#241;&#252; &#239;&#238;&#235;&#229;&#233; &#231;&#224;&#239;&#232;&#241;&#232;
            If IsNull(fldField) = True Then
            Else
                Set xmlField = xmlFields3.appendChild( _
                xmlDoc.createElement(Replace(fldField.Name, " ", "_")))
                xmlField.Text = fldField.Value
            End If
          Next
         .MoveNext   ' &#234; &#241;&#235;&#229;&#228;&#243;&#254;&#249;&#229;&#233; &#231;&#224;&#239;&#232;&#241;&#232; &#237;&#224;&#225;&#238;&#240;&#224;
          i = i + 1
      Loop
   End With
Set rs2 = CurrentDb.OpenRecordset("SELECT Caption_OUT1.* FROM Caption_OUT1")
'  With rs2
'       '&#194;&#251;&#226;&#238;&#228; &#241;&#238;&#228;&#229;&#240;&#230;&#232;&#236;&#238;&#227;&#238; &#239;&#238;&#235;&#229;&#233; &#242;&#224;&#225;&#235;&#232;&#246;&#251;
'      .MoveFirst: i = 1
'       Do Until .EOF
'          ' &#241;&#238;&#231;&#228;&#224;&#237;&#232;&#229; &#237;&#238;&#226;&#238;&#227;&#238; &#243;&#231;&#235;&#224;3
'
'          For Each fldField In rs2.Fields   ' &#231;&#224;&#239;&#232;&#241;&#252; &#239;&#238;&#235;&#229;&#233; &#231;&#224;&#239;&#232;&#241;&#232;
'            If IsNull(fldField) = True Then
'            Else
''                Set xmlField = xmlFields3.appendChild( _
''                xmlDoc.createElement(Replace(fldField.Name, " ", "_")))
'                'xmlField.Text = fldField.Value
'                xmlFields3.setAttribute "&#202;&#238;&#228;&#209;&#242;&#240;&#238;&#234;&#232;", rs2.Fields("FB8")
'
'                If rs.EOF Then Exit Do
'                    rs.MoveNext
'                    Current_client = rs.Fields("&#202;&#238;&#228;&#209;&#242;&#240;&#238;&#234;&#232;")
''                  Loop
'
'                  If rs.EOF Then Exit Do
'                  rs.MoveNext
'
'                End If
'          Next
'         .MoveNext   ' &#234; &#241;&#235;&#229;&#228;&#243;&#254;&#249;&#229;&#233; &#231;&#224;&#239;&#232;&#241;&#232; &#237;&#224;&#225;&#238;&#240;&#224;
'          i = i + 1
'      Loop
'   End With
   Set RecordsetToXMLDOM = xmlDoc   ' &#226;&#238;&#231;&#226;&#240;&#224;&#249;&#224;&#229;&#236; &#241;&#238;&#231;&#228;&#224;&#237;&#237;&#251;&#233; &#238;&#225;&#250;&#229;&#234;&#242;
    rs1.Close
    rs2.Close
    rs.Close
End Function

Private Sub &#226;&#251;&#227;&#240;&#243;&#231;&#232;&#242;&#252;_Click()
Dim strConnectString$, strSQL$, strHeading$
    strHeading = "UFormatAPK"

    Dim rs As Recordset
    Dim rs1 As Recordset
    Dim MySQL As Variant
    Dim MySQL1 As Variant
    Set MyDB = CurrentDb
    MySQL = "SELECT * FROM Caption_OUT"
    MySQL1 = "SELECT Caption_OUT1.* FROM Caption_OUT1"
    Set rs = MyDB.OpenRecordset(MySQL)
    Set rs1 = MyDB.OpenRecordset(MySQL1)

   Call ExportXML(rs, strHeading$, "d:\xml\file1.xml")
'Call Module1.CreateXML
End Sub

<?xml version="1.0" encoding="UTF-8"?>

-<UFormatAPK>


-<ORG>

<FullName>Иванов ВВ</FullName>

<SuperiorOrg>6317</SuperiorOrg>

<INN>637700046961</INN>

<ActivityForm>1</ActivityForm>


-<Account>


-<Report>

<CodeReport>f10af</CodeReport>

<Period>0_2016</Period>

<Code>17.02.2016</Code>

</Report>

</Account>

</ORG>

</UFormatAPK>

<Account>
			<Report>
				<CodeOfReport>f10af</CodeOfReport>
				<Period>0_2016</Period>
				<parameter Code="парДатаОтчета"	Value=""/>
				<parameter Code="парДатаУтверждения"	Value=""/>
				<parameter Code="парДатаОтправки"	Value=""/>
				<parameter Code="парДатаПодписи"	Value="2017-01-25"/>
				<index String="065" Column="9" Value="48,639"/>
				<index String="065" Column="8" Value="113,491"/>
				<index String="065" Column="14" Value="0"/>
				<index String="065" Column="13" Value="-48,639"/>
				<index String="065" Column="12" Value="-113"/>
				<index String="065" Column="10" Value="0"/>
				<index String="065" Column="19" Value="113,491"/>

			</Report>
		</Account>