Option Compare Database

Private Sub Filtr_Click()
    pFilter = "Day(DataG)= " & Day(DataN) & " AND Month(DataG)=" & Month(DataN) & " AND Year(DataG)=" & Year(DataN)
    Me.Filter = pFilter
    Me.FilterOn = True
    Me.Refresh
End Sub

' экспорт в xml файл для связи продукция-сырье
Private Sub pXmlPS_Click()
Dim rs As DAO.Recordset, s, t1, t2

NameTXT = "D:\Jelatin_Kosti.xml"
Me.Refresh
Set dbs = CurrentDb()

' запрос к исходной таблице qJelatinXmlSur
s = "SELECT tbJelatin.NomPart, tbJelatin.DataG, tbJelatin.Guin,"
s = s & " tbPodKos.NomAkt as nomAktK,tbPodKos.DataK ,tbPodKos.GiunK,"
s = s & " [ProdK] AS Npart"
s = s & " FROM tbJelatin"
s = s & " INNER JOIN tbPodKos ON tbJelatin.Kod = tbPodKos.ProdK"
''s = s & "  WHERE (((tbJelatin.prn) = True))"
s = s & " ORDER BY tbJelatin.NomPart, tbJelatin.DataG, tbJelatin.Guin,[ProdK]"
Debug.Print s
Set rs = dbs.OpenRecordset(s, dbOpenDynaset, DB_CONSISTENT, dbPessimistic)
If rs.RecordCount = 0 Then
    MsgBox "Данные по актам кости отсутствуют!", vbInformation, "ВНИМАНИЕ"
    rs.Close
    dbs.Close
Else
rs.MoveFirst
MsgBox "Файл " & NameTXT & " сохранен в папку", vbInformation, "ВНИМАНИЕ"
Open NameTXT For Output As #1
'пишем заголовок
Print #1, "<?xml version='1.0' encoding='UTF-8'?>"
Print #1, "<ArrayOfItemPart xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xmlns:xsd='http://www.w3.org/200l/XMLSchema'>"
t1 = "**"
   While Not rs.EOF
   t2 = rs!NomPart & "`" & rs!DataG & "`" & rs!Guin
   If t1 <> t2 Then
   If t1 <> "**" Then
    Print #1, "</NPART>"
    Print #1, "</ItemPart>"
   End If
        ' rs.Fields(0) - номер партии;     rs.Fields(1) - дата;              rs.Fields(2) - GUIN;            rs.Fields(3) - № акта +  дата акта + Guin акта сырья;
        Print #1, "<ItemPart>"
        Print #1, "<TYPEOTR>2</TYPEOTR>"
        Print #1, "<POL>4810077900006:ОАО " & Chr(34) & "МОЖЕЛИТ" & Chr(34) & " г. Могилев" & "</POL>"
        Print #1, "<PARTR>" & Trim(rs.Fields(0)) & Chr(58) & Format(rs.Fields(1), "dd\.mm\.yyyy") & Chr(58) & Trim(rs.Fields(2)) & "</PARTR>"
        Print #1, "<NPART>"
        t1 = t2
        End If
        Print #1, Trim(rs!NomAktK) & ":" & rs!DataK & ":" & Trim(rs!GiunK) & ";"
         
        
        rs.MoveNext
Wend
Print #1, "</NPART>"
    Print #1, "</ItemPart>"
Print #1, "</ArrayOfItemPart>"
Close #1
rs.Close
dbs.Close
End If
Set rs = Nothing
WinToUTF (NameTXT)

End Sub

 While Not rs.EOF
   t2 = rs!NomPart & "`" & rs!DataG & "`" & rs!Guin
   If t1 <> t2 Then
    s="" '''разделитель для первой подзаписи
   If t1 <> "**" Then
    Print #1, "</NPART>"
    Print #1, "</ItemPart>"

   End If
        ' rs.Fields(0) - номер партии; rs.Fields(1) - дата;  rs.Fields(2) - GUIN;  
        'rs.Fields(3) - № акта +  дата акта + Guin акта сырья;
        Print #1, "<ItemPart>"
        Print #1, "<TYPEOTR>2</TYPEOTR>"
        Print #1, "<POL>4810077900006:ОАО " & Chr(34) & "МОЖЕЛИТ" & Chr(34) & " г. Могилев" & "</POL>"
        Print #1, "<PARTR>" & Trim(rs.Fields(0)) & Chr(58) & Format(rs.Fields(1), "dd\.mm\.yyyy") & Chr(58) & Trim(rs.Fields(2)) & "</PARTR>"
        Print #1, "<NPART>"
        t1 = t2
        End If
        Print #1, s & Trim(rs!NomAktK) & ":" & rs!DataK & ":" & Trim(rs!GiunK) 
         s= ";"   ''' для следующих
        
        rs.MoveNext
Wend