Там какой-либо путь состоит в том, чтобы заставить Excel сохранить атрибуты XML в корневом элементе?

Хорошо, я укусил пулю и написал старый добрый макрос VBA. Я решил поделиться им со всеми вами на случай, если кто-то еще столкнется с той же проблемой.

Этот макрос в основном вызывает встроенный в Excel метод XML Export (), а затем выполняет серию замен текста в полученном файле. Замена текста полностью зависит от вас. Просто поместите их на лист, подобный тому, который указан по ссылке ниже ...

Пример того, как настроить «правила замены»: (Вам будет предложено указать файл, в который вы хотите экспортировать.)

* Если вы не знакомы с диапазонами имен в Excel 2007, щелкните вкладку Формулы и выберите Диспетчер имен.

Хорошо, я не буду сохранять Вы больше в напряжении (LOL) ... вот код макроса. Просто поместите его в модуль в редакторе VBA. Я не предлагаю никаких гарантий с этим бесплатным кодом (вы можете легко сломать его, если не назовете диапазоны должным образом), но пара примеров, которые я пробовал, сработали для меня.

Option Explicit

Sub ExportXml()
    Dim exportResult As XlXmlExportResult
    Dim exportPath As String
    Dim xmlMap As String
    Dim fileContents As String
    exportPath = RequestExportPath()
    If exportPath = "" Or exportPath = "False" Then Exit Sub
    xmlMap = range("XmlMap")
    exportResult = ActiveWorkbook.XmlMaps(xmlMap).Export(exportPath, True)
    If exportResult = xlXmlExportValidationFailed Then
        Beep
        Exit Sub
    End If
    fileContents = ReadInTextFile(exportPath)
    fileContents = ApplyReplaceRules(fileContents)
    WriteTextToFile exportPath, fileContents
End Sub

Function ApplyReplaceRules(fileContents As String) As String
    Dim replaceWorksheet As Worksheet
    Dim findWhatRange As range
    Dim replaceWithRange As range
    Dim findWhat As String
    Dim replaceWith As String
    Dim cell As Integer
    Set findWhatRange = range("FindWhat")
    Set replaceWithRange = range("ReplaceWith")
    For cell = 1 To findWhatRange.Cells.Count
        findWhat = findWhatRange.Cells(cell)
        If findWhat <> "" Then
            replaceWith = replaceWithRange.Cells(cell)
            fileContents = Replace(fileContents, findWhat, replaceWith)
        End If
    Next cell
    ApplyReplaceRules = fileContents
End Function

Function RequestExportPath() As String
    Dim messageBoxResult As VbMsgBoxResult
    Dim exportPath As String
    Dim message As String
    message = "The file already exists. Do you want to replace it?"
    Do While True
        exportPath = Application.GetSaveAsFilename("", "XML Files (*.xml),*.xml")
        If exportPath = "False" Then Exit Do
        If Not FileExists(exportPath) Then Exit Do
        messageBoxResult = MsgBox(message, vbYesNo, "File Exists")
        If messageBoxResult = vbYes Then Exit Do
    Loop
    RequestExportPath = exportPath
End Function

Function FileExists(path As String) As Boolean
    Dim fileSystemObject
    Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
    FileExists = fileSystemObject.FileExists(path)
End Function

Function ReadInTextFile(path As String) As String
    Dim fileSystemObject
    Dim textStream
    Dim fileContents As String
    Dim line As String
    Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set textStream = fileSystemObject.OpenTextFile(path)
    fileContents = textStream.ReadAll
    textStream.Close
    ReadInTextFile = fileContents
End Function

Sub WriteTextToFile(path As String, fileContents As String)
    Dim fileSystemObject
    Dim textStream
    Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set textStream = fileSystemObject.CreateTextFile(path, True)
    textStream.Write fileContents
    textStream.Close
End Sub