Замена пространств имен XML через VBA не работает после добавления новых данных

Question

Я генерирую XML-файл из таблицы Excel с кодом VBA.Код также заменяет пространства имен, которые Excel неправильно называет.Это работает, пока у меня есть только один набор данных для элемента (элемент может встречаться более одного раза).Как только я хочу добавить новые данные, код VBA только создает и сохраняет файл без изменения пространств имен.Может кто-нибудь сказать мне, как изменить код, чтобы он по-прежнему изменял пространства имен после добавления новых элементов?

Код 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

Я назвал все, что хотел изменить FindWhat и все, что должно его заменить ReplaceWith.

Я ожидаю, что вывод будет, например, Melder, вместо этого он все еще показывает мне ns1:Melder.Это происходит только тогда, когда у меня есть несколько списков элементов.В противном случае это работает.

Пример XML, который я получаю прямо сейчас:

<?xml version="1.0" encoding="UTF-8"?>
<ns1:LIEFERUNG-DIREK xmlns:ns1="http://www.bundesbank.de/xmw/direk/2015-01-01" xmlns:ns2="http://www.bundesbank.de/xmw/2003-01-01" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" version="1" erstellzeit="2001-12-17T09:30:47Z" stufe="Test" dateireferenz="1" bereich="Statistik">
        <ns1:MELDER>
            <ns1:FIRMENNR>Muster</ns1:FIRMENNR>
            <ns1:NAME>Muster</ns1:NAME>
        </ns1:MELDER>   
        <ns1:FORMULAR-K3>
               <ns1:K3 lfdnr="1" meldeart="endgueltig">
                 <ns1:BILANZ>
                    <ns1:BILANZSTICHTAG>2015-12-31</ns1:BILANZSTICHTAG>
                 </ns1:BILANZ>
               </ns1:K3>
               <ns1:K3 lfdnr="2" meldeart="endgueltig">
                 <ns1:BILANZ>
                    <ns1:BILANZSTICHTAG>2015-12-31</ns1:BILANZSTICHTAG>
                 </ns1:BILANZ>
               </ns1:K3>
        </ns1:FORMULAR-K3>
</ns1:LIEFERUNG-DIREK>

Что мне нужно:

<?xml version="1.0" encoding="UTF-8"?>
<LIEFERUNG-DIREK xmlns:bbk="http://www.bundesbank.de/xmw/2003-01-01" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns="http://www.bundesbank.de/xmw/direk/2015-01-01" version="1.0" erstellzeit="2019-06-07T08:30:54Z" stufe="Test" dateireferenz="1" bereich="Statistik" xsi:schemaLocation="http://www.bundesbank.de/xmw/direk/2015-01-01 BbkXmwDirek_2015.xsd">
        <bbk:MELDER>
            <FIRMENNR>Muster</FIRMENNR>
            <bbk:NAME>Muster</bbk:NAME>
        </bbk:MELDER>   
        <FORMULAR-K3>
            <K3 lfdnr="1" meldeart="endgueltig">
                <BILANZ>
                    <BILANZSTICHTAG>2015-12-31</BILANZSTICHTAG>
                </BILANZ>
            </K3>
            <K3 lfdnr="2" meldeart="endgueltig">
                <BILANZ>
                    <BILANZSTICHTAG>2015-12-31</BILANZSTICHTAG>
                </BILANZ>
            </K3>
        </FORMULAR-K3>
</LIEFERUNG-DIREK>

Как видите, K3появляется более одного раза.Если он появляется только один раз, код работает.

Answer 1

Вместо того, чтобы обрабатывать изменения XML с помощью чтения / записи текстовых файлов, рассмотрим XSLT , язык специального назначения, предназначенный для преобразования XML. VBA может запускать сценарии XSLT 1.0 с библиотекой MSXML. Одной из сильных сторон XSLT является обработка пространств имен, включая стандартные и множественные префиксы, что является проблемой с вашими потребностями.

В частности, ниже XSLT проходит по дереву, переписывая необходимые элементы для своих локальных имен (то есть без префиксов), сопоставляя новое значение по умолчанию: xmlns="http://www.bundesbank.de/xmw/direk/2015-01-01".

XSLT (сохранить ниже как файл .xsl, специальный файл .xml)

<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
                              xmlns:doc="http://www.bundesbank.de/xmw/direk/2015-01-01"
                              xmlns:bbk="http://www.bundesbank.de/xmw/2003-01-01"
                              xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
                              xsi:schemaLocation="http://www.bundesbank.de/xmw/direk/2015-01-01 BbkXmwDirek_2015.xsd"
                              xmlns:ext="urn:schemas-microsoft-com:xslt"
                              exclude-result-prefixes="ext" >
  <xsl:output indent="yes"/>
  <xsl:strip-space elements="*"/>

    <xsl:param name="bbk_nmsp" select="'http://www.bundesbank.de/xmw/2003-01-01'"/>
    <xsl:variable name="vbbk">
       <xsl:element name="bbk:x" namespace="{$bbk_nmsp}"/>
    </xsl:variable>

    <!-- IDENTITY TRANSFORM -->
    <xsl:template match="@*|node()">
        <xsl:copy>
            <xsl:apply-templates select="@*|node()"/>
        </xsl:copy>
    </xsl:template>

    <xsl:template match="doc:LIEFERUNG-DIREK">
        <xsl:element name="LIEFERUNG-DIRE" namespace="http://www.bundesbank.de/xmw/direk/2015-01-01">
            <xsl:copy-of select="namespace::*[.='xsi']"/>
            <xsl:copy-of select="ext:node-set($vbbk)/*/namespace::*[.=$bbk_nmsp]"/>
            <xsl:attribute name="xsi:schemaLocation">http://www.bundesbank.de/xmw/direk/2015-01-01 BbkXmwDirek_2015.xsd</xsl:attribute>
            <xsl:apply-templates select="node()|@*"/>
        </xsl:element>
    </xsl:template>

    <xsl:template match="doc:MELDER">
        <xsl:element name="bbk:MELDER">
            <xsl:apply-templates select="node()|@*"/>
        </xsl:element>
    </xsl:template>

    <xsl:template match="doc:FIRMENNR|doc:NAME|doc:FORMULAR-K3|doc:K3|doc:BILANZ|doc:BILANZSTICHTAG">
        <xsl:element name="{local-name()}" namespace="http://www.bundesbank.de/xmw/direk/2015-01-01">
            <xsl:apply-templates select="node()|@*"/>
        </xsl:element>
    </xsl:template>

</xsl:stylesheet>

Демо онлайн

1020 * VBA *

Sub XSLTransform()
On Error GoTo ErrHandle
    Dim xmldoc As New MSXML2.DOMDocument, xslDoc As New MSXML2.DOMDocument
    Dim newDoc As New MSXML2.DOMDocument

    ' LOAD XML AND XSL FILES
    xmlDoc.async = False
    xmlDoc.Load "C:\Path\To\InputXML.xml"

    xslDoc.async = False    
    xslDoc.Load "C:\Path\To\XSLT_Script.xml"        

    ' TRANSFORM XML 
    xmldoc.transformNodeToObject xslDoc, newDoc
    newDoc.Save "C:\Path\To\OutputXML.xml"

    Set xmlDoc = Nothing: Set xslDoc = Nothing: Set newDoc = Nothing
End Sub