I have a directory with multiple XML-Files. New XML-Files are added to the directory every day.
I´m trying to import those XML-Files into one specific Excel Sheet everyday, without overwriting the existing data in my Excel Sheet.
I have already managed to import the XML-Files.
Hope anyone can help me out with this. Trying to find a solution for quite a long time and couldn´t find an answer by myself or online.
This is the Structure of my XML-Files:
<?xml version="1.0" encoding="utf-8"?>
<MFK_XML xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
<Auftrag>
<WarenkorbReferenz>0</WarenkorbReferenz>
<JobNr>12345-999</JobNr>
<KuNr>12345</KuNr>
<ReNr>7</ReNr>
<SoA>0</SoA>
<Termin>2020-03-10</Termin>
<Versandtermin>2020-03-09</Versandtermin>
<Gewicht>1.1037620</Gewicht>
<Datencheck>0</Datencheck>
<Proof>0</Proof>
<Kundenhinweis />
<Auflage>5</Auflage>
<Versionen>1</Versionen>
<Gesamtpreis>15.50</Gesamtpreis>
<Priority>S</Priority>
<ProduktionsTage>5</ProduktionsTage>
<Mandant />
<LNr>151</LNr>
<IVB>10</IVB>
<Gratis>0</Gratis>
<Transfer>2020-03-02</Transfer>
</Auftrag>
<Artikel>
<Artikelbezeichnung>Broschüre mit Metall-Spiralbindung, Endformat DIN A4, 48-seitig</Artikelbezeichnung>
<ArtikelID>12345</ArtikelID>
<ArtStr>Flex</ArtStr>
<ProdKrzl>FlX</ProdKrzl>
<Sorte>135g Innenteil mit 250g Umschlag (matt, hochwertiger Qualitätsdruck, 4/4-farbig)</Sorte>
<SortenID>152</SortenID>
<Seitenzahl>48</Seitenzahl>
<SeitenZahlMalVersionen>48</SeitenZahlMalVersionen>
<Seitenzahlgesamt>48</Seitenzahlgesamt>
<SeitenzahlInhalt />
<SeitenzahlUmschlag />
<Farbigkeit>44</Farbigkeit>
<FarbigkeitInhalt />
<FarbigkeitUmschlag />
<PapierInnen>135g Innenteil</PapierInnen>
<PapierUmschlag>250g Umschlag (matt, hochwertiger Qualitätsdruck, 4/4-farbig)</PapierUmschlag>
<Endformat_mm_X>210</Endformat_mm_X>
<Endformat_mm_Y>297</Endformat_mm_Y>
<Datenformat_mm_X>216</Datenformat_mm_X>
<Datenformat_mm_y>303</Datenformat_mm_y>
<FormatUmschlag_x />
<FormatUmschlag_y />
<EndFormatUmschlag_x />
<EndFormatUmschlag_y />
<Falzart>0</Falzart>
<Falzlauf />
<gefendFormat_x />
<gefendFormat_y />
<BeschnittI>3</BeschnittI>
<BeschnittU />
<Bundstaerke>3</Bundstaerke>
<vWd>0</vWd>
<pWd>0</pWd>
<vUV>0</vUV>
<pUV>0</pUV>
<Rillung>0</Rillung>
<KissCut>0</KissCut>
<Druckverfahren>Druck</Druckverfahren>
<dataformat>pdf</dataformat>
<Zusatzinfo>Schwarz</Zusatzinfo>
</Artikel>
<Optionen>
<Veredelung>0</Veredelung>
<Falzung>0</Falzung>
<Ausrichtung>0</Ausrichtung>
<Heften>0</Heften>
<Nutung>0</Nutung>
<Buendelung>0</Buendelung>
<Leimung>0</Leimung>
<Perforierung>0</Perforierung>
<Sonderfarbe>0</Sonderfarbe>
<Lochbohrungen_Ecken>0</Lochbohrungen_Ecken>
<Nummerierung>0</Nummerierung>
<Barcode>0</Barcode>
<Hologramm>0</Hologramm>
<Abheftvorrichtung>0</Abheftvorrichtung>
<Cello>
<Cellophaniert>0</Cellophaniert>
<CelloArt>0</CelloArt>
</Cello>
<stanze>
<StanzeForm>keine</StanzeForm>
<StanzeOffset>0</StanzeOffset>
</stanze>
<Einschweissen>0</Einschweissen>
<Fadenheftung>0</Fadenheftung>
<Werbefolie>0</Werbefolie>
<Ecken_abrunden>0</Ecken_abrunden>
<RAL_Farbe>0</RAL_Farbe>
<Gummiband_Verschluss>0</Gummiband_Verschluss>
<HKS_Pantone>0</HKS_Pantone>
<Lochung>0</Lochung>
<PP_Deck>0</PP_Deck>
<DeckBl_V>0</DeckBl_V>
<DeckBl_V_H>0</DeckBl_V_H>
<Praegung>0</Praegung>
<Rubbelfeld>0</Rubbelfeld>
<Magnetstreifen>0</Magnetstreifen>
<Unterschriftsfeld>0</Unterschriftsfeld>
<Magnetpunkt_Verschluss>0</Magnetpunkt_Verschluss>
<Griffloch>0</Griffloch>
<Verchromte_Buchecken>0</Verchromte_Buchecken>
<Rueckentasche>0</Rueckentasche>
<Visitenkartentasche>0</Visitenkartentasche>
<Dreieckstasche>0</Dreieckstasche>
<Kombitasche>0</Kombitasche>
<CD_Tasche>0</CD_Tasche>
<Radooesen>0</Radooesen>
<Postkarten_indiv_personalisieren>0</Postkarten_indiv_personalisieren>
<LED_Halogenbeleuchtung>0</LED_Halogenbeleuchtung>
<Klima>1</Klima>
</Optionen>
<Zusatzkosten />
<Dateien>
<Dateiname>12345-999.pdf</Dateiname>
</Dateien>
<WF_Name>
<WF_Name>12345-999.pdf</WF_Name>
</WF_Name>
</MFK_XML>
Here´s the Code of the VBA:
Sub From_XML_To_XL()
Dim xWb As Workbook
Dim xSWb As Workbook
Dim xStrPath As String
Dim xFileDialog As FileDialog
Dim xFile As String
Dim xCount As Long
On Error GoTo ErrHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a folder"
If xFileDialog.Show = -1 Then
xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub
Application.ScreenUpdating = False
Set xSWb = ThisWorkbook
xCount = 1
xFile = Dir(xStrPath & "\*.xml")
Do While xFile <> ""
Set xWb = Workbooks.OpenXML(xStrPath & "\" & xFile)
xWb.Sheets(1).UsedRange.Copy xSWb.Sheets(1).Cells(xCount, 1)
xWb.Close False
xCount = xSWb.Sheets(1).UsedRange.Rows.Count + 2
xFile = Dir()
Loop
Application.ScreenUpdating = True
xSWb.Save
Exit Sub
ErrHandler:
MsgBox "no files xml"
End Sub
Consider XSLT, the special-purpose language to transform XML files, which you can use its document()
function to combine all XMLs in the directory. Then, import the resulting transformed file as one document into Excel. Office VBA can run XSLT 1.0 with the MSXML library.
Below assumes exact structure is retained in all XML files (regardless of recurring elements) where each document maps to root level <MFK_XML>
. Add to the below <xsl:copy-of ...>
lines for each document. Should you have hundreds, consider building XSLT document in a loop with VBA, Python, etc. If files are relatively small as posted, XSLT is a viable solution but does have memory limitations.
XSLT (save as .xsl, a special .xml file)
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:output indent="yes" encoding="UTF-8"/>
<xsl:strip-space elements="*"/>
<xsl:template match="/MFK_XML">
<MFK_XML>
<xsl:copy-of select="document('First.xml')/MFK_XML/*" />
<xsl:copy-of select="document('Second.xml')/MFK_XML/*" />
<xsl:copy-of select="document('Third.xml')/MFK_XML/*" />
<!-- ADD: <xsl:copy-of select="document('XXXX.xml')/MFK_XML/*" /> -->
</MFK_XML>
</xsl:template>
<xsl:template match="@*|node()">
<xsl:copy>
<xsl:apply-templates select="@*|node()"/>
</xsl:copy>
</xsl:template>
</xsl:stylesheet>
VBA (no loop is needed)
Sub XSLTransform()
On Error GoTo ErrHandle
' ENABLE Microsoft XML, v#.# IN REFERENCES
Dim xmldoc As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60
Dim newDoc As New MSXML2.DOMDocument60
Dim xWb As Workbook
' LOAD XML AND XSL FILES
xmldoc.async = False
xmldoc.Load "C:\Path\To\Any.xml"
xslDoc.async = False
xslDoc.Load "C:\Path\To\Script.xsl"
xslDoc.setProperty "AllowDocumentFunction", True
' TRANSFORM XML
xmldoc.transformNodeToObject xslDoc, newDoc
newDoc.Save "C:\Path\To\Transformed.xml"
Set xWb = Workbooks.OpenXML("C:\Path\To\Transformed.xml")
xWb.SaveAs "C:\Path\To\Final.xlsx"
xWb.Close False
ExitHandle:
Set xmldoc = Nothing: Set xslDoc = Nothing: Set newDoc = Nothing
Set xWb = Nothing
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Resume ExitHandle
End Sub