excelxmlvbaxml-import

How to Import multiple XML Files into Excel with VBA without overwriting the files that have already been imported


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

Solution

  • 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