Replacing of XML Namespaces via VBA doesn't work after adding new data - excel

Question

I'm generating a XML file from an Excel table with a VBA code. The code also replaces namespaces that Excel names incorrectly. It works, as long as I only have a single set of data for an element (the element can occur more than once). As soon as I want to add new data, the VBA code only creates and saves the file without changing the namespaces. Can someone tell me how to change the code so it still changes the namespaces after adding new elements?
The VBA code:
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
I named everything I wanted to change FindWhat and everything that should replace it ReplaceWith.
I expect the output to be e.g. Melder, instead it still shows me ns1:Melder. This only happens, when I have more than one listing of an element. Otherwise it works.
A sampel of the XML I get right now is:
<?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>
What I need:
<?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>
As you can see K3 appears more than once. If it only appears once, the code works.

Answer 1

Rather than handle XML changes using text files read/writes, consider XSLT, the special-purpose language designed to transform XML. VBA can run XSLT 1.0 scripts with the MSXML library. One of XSLT's strengths is handling namespaces including default and multiple prefixes which is a challenge with your needs.
Specifically, below XSLT walks down the tree re-writing the needed elements for their local names (i.e., without prefixes) mapping to the new default: xmlns="http://www.bundesbank.de/xmw/direk/2015-01-01".
XSLT (save below as .xsl file, a special .xml file)
<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>
Online Demo
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