Сохранить как XML с VBA?

Question

Есть ли способ сохранить таблицу Excel в формате XML? У меня есть файл схемы XML ... и некоторые данные в таблице ... и в Excel у меня есть опция Сохранить как файл XML, но можно ли сохранить файл в формате XML из VBA? Я хочу автоматизировать процесс, и я ничего не нашел в этой опции. Спасибо!

Answer 1

Хороший старый рекордер макросов спас меня на этот раз :)) (Почему я не использовал его до того, как опубликовал здесь?) Итак ... Чтобы загрузить XML-схему, у вас есть:

ActiveWorkbook.XmlMaps.Add("Book2.xml", "raport").Name _
        = "raport_Map"

И сохранить его как XML:

ActiveWorkbook.SaveAsXMLData Filename:="Book3.xml", _
        Map:=ActiveWorkbook.XmlMaps("raport_Map")

Кто бы мог подумать, что это так просто?

Answer 2

Эта ссылка помогла мне больше всего -> http://curiousmind.jlion.com/exceltotextfile

Скрипт по ссылке:

Sub MakeXML(iCaptionRow As Integer, iDataStartRow As Integer, sOutputFileName As String)
    Dim Q As String
    Q = Chr$(34)

    Dim sXML As String

    sXML = "<?xml version=" & Q & "1.0" & Q & " encoding=" & Q & "UTF-8" & Q & "?>"
    sXML = sXML & "<rows>"


    ''--determine count of columns
    Dim iColCount As Integer
    iColCount = 1
    While Trim$(Cells(iCaptionRow, iColCount)) > ""
        iColCount = iColCount + 1
    Wend

    Dim iRow As Integer
    iRow = iDataStartRow

    While Cells(iRow, 1) > ""
        sXML = sXML & "<row id=" & Q & iRow & Q & ">"

        For icol = 1 To iColCount - 1
           sXML = sXML & "<" & Trim$(Cells(iCaptionRow, icol)) & ">"
           sXML = sXML & Trim$(Cells(iRow, icol))
           sXML = sXML & "</" & Trim$(Cells(iCaptionRow, icol)) & ">"
        Next

        sXML = sXML & "</row>"
        iRow = iRow + 1
    Wend
    sXML = sXML & "</rows>"

    Dim nDestFile As Integer, sText As String

    ''Close any open text files
    Close

    ''Get the number of the next free text file
    nDestFile = FreeFile

    ''Write the entire file to sText
    Open sOutputFileName For Output As #nDestFile
    Print #nDestFile, sXML
    Close
End Sub

Sub test()
    MakeXML 1, 2, "C:\Users\jlynds\output2.xml"
End Sub