Экспорт данных листов excel в xml

Sub send_to_xml_Click()
Dim strConnectString$, strSQL$, strHeading$
Dim cnn As ADODB.Connection
Dim rs As Recordset
 
'листаем книгу
For i = 1 To ThisWorkbook.Sheets.Count
'    For Each f In Worksheets(i).Range(Module3.scan_diap)
    ''''''''''''''''''''''''''и превращаем данные в record set
      NameDir = ThisWorkbook.Path & ""
      strConnectString = "Provider=MSDASQL.1;Persist Security Info=True;" & _
            "Data Source = Файлы Excel;Initial Catalog=" & NameDir
    
      'strConnectString = "Provider=Microsoft.Jet.OLEDB.3.51;" & _
        "Persist Security Info=False;" & _
         "Data Source=C:vb-dbxmltest.mdb"
         'scan_diap
      strSQL = "SELECT * FROM [" & Worksheets(i).Name & "$" & Module3.scan_diap & _
      "] IN '" & ThisWorkbook.FullName & "' [Excel 5.0;HDR=NO;IMEX=2];"
 
      strHeading$ = "preds"
      Set cnn = New ADODB.Connection
      Set rs = New ADODB.Recordset
      cnn.Open strConnectString$   ' устанавливаем связь
      Set rs = cnn.Execute(strSQL) ' создаем Recordset
      Call ExportXML(rs, strHeading$, strCode, "d:file1.xml") 'грузим в xml
'    Next f
Next i
 
End Sub
 
Public Sub ExportXML(rs As Recordset, strHeading$, strCode, FileName$) '
   ' Экспорт таблицы RecordSet в XML файл
   Dim xmlDoc As DOMDocument
 
   ' Cоздаем XMLDOM-объект
   Set xmlDoc = RecordsetToXMLDOM(rs, strHeading$, strCode) '
   ' выводим его в виде отдельного файла
   xmlDoc.Save FileName$
End Sub
 
Public Function RecordsetToXMLDOM(rs As Recordset, strHeading$, strCode) 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 + "/>", " ", "_")
'      Replace("<" + strHeading + "/>", " ", "_") 
 
   With rs
      ' Вывод содержимого полей таблицы
      .MoveFirst: i = 1
       Do Until .EOF
          ' создание нового узла
          Set xmlFields = xmlCode.documentElement.appendChild _
            (xmlDoc.createElement("OneRow" + LTrim(Str(i))))
 
          For Each fldField In rs.Fields   ' запись полей записи
               Set xmlField = xmlFields.appendChild( _
                xmlDoc.createElement(Replace(fldField.Name, " ", "_")))
                If IsNull(fldField.Value) = False Then
                    xmlField.Text = fldField.Value
                End If
          Next
         .MoveNext   ' к следующей записи набора
          i = i + 1
      Loop
   End With
   Set RecordsetToXMLDOM = xmlDoc   ' возвращаем созданный объект
End Function

Call UploadFile("http://localhost", "C:1.xml")