¿Hay alguna forma de hacer que Excel conserve los atributos XML en el elemento raíz?

Solución:

De acuerdo, bueno, mordí la bala y escribí una buena macro de VBA. Pensé que lo compartiría con todos ustedes en caso de que alguien más se encuentre con el mismo problema.

Esta macro básicamente llama al método XML Export () integrado de Excel y luego realiza una serie de reemplazos de texto en el archivo resultante. Los reemplazos de texto dependen completamente de usted. Simplemente colóquelos en una hoja de trabajo como la del enlace de abajo …

Un ejemplo de cómo configurar las “reglas de reemplazo”: haz clic en mí para ver el límite de pantalla

En este ejemplo, reemplacé tabulador con espacio-espacio, “: ns1” con espacio en blanco, “ns1:” con espacio en blanco y el elemento raíz reducido con el elemento raíz original.

Puede formatear sus reglas de reemplazo de la forma que desee, siempre y cuando siga estas instrucciones:

1. Seleccione todas las celdas de “buscar qué” y asígneles el nombre * “FindWhat” (no incluya una fila de encabezado en su selección; los espacios en blanco serán ignorados).
2. Seleccione todas las celdas “reemplazar con” y asígneles el nombre * “Reemplazar con” (debe haber un mapeo uno a uno entre las celdas “buscar qué” y “reemplazar con”; use espacios en blanco para eliminar el texto no deseado).
3. Ingrese el nombre del mapa XML en algún lugar de su libro de trabajo y nombre esa celda “XmlMap”.
4. Ejecute la macro. (Se le pedirá que especifique el archivo al que desea exportar).

* Si no está familiarizado con los rangos de nombres en Excel 2007, haga clic en la pestaña Fórmulas y elija Administrador de nombres.

Está bien, ya no te mantendré en suspenso (LOL) … aquí está el código de la macro. Simplemente colóquelo en un módulo en el editor de VBA. No ofrezco garantías con este código gratuito (podría romperlo fácilmente si no nombra los rangos correctamente), pero los dos ejemplos que he probado me han funcionado.

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

---

---

Utiliza Nuestro Buscador