Как импортировать несколько XML файлов в Excel с VBA без перезаписи файлов, которые уже были импортированы

Question

У меня есть каталог с несколькими XML -файлами. Новые XML -файлы добавляются в каталог каждый день.

Я пытаюсь импортировать эти XML -файлы в один указанный c лист Excel каждый день, без перезаписи существующих данных в моем Excel Лист.

Мне уже удалось импортировать XML -файлы.

• Вопрос 1: Как я могу импортировать XML -файлы без заголовков или xml путь?
• Вопрос 2: Есть ли способ импортировать только новые данные и пропустить файлы, которые я уже импортировал

Надеюсь, кто-нибудь может мне помочь с этим. Пытаюсь найти решение довольно долго и не могу найти ответ сам или онлайн.

Это структура моих XML -файлов:

<?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> 

Вот код 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

Answer 1

Рассмотрим XSLT , специализированный язык для преобразования XML файлов, который можно использовать с его функцией document() для объединения всех XML-файлов в каталоге. Затем импортируйте полученный преобразованный файл как один документ в Excel. Office VBA может запускать XSLT 1.0 с библиотекой MS XML.

Ниже предполагается, что точная структура сохраняется во всех XML файлах (независимо от повторяющихся элементов), где каждый документ отображается на root уровень <MFK_XML>. Добавьте к приведенным ниже <xsl:copy-of ...> строкам для каждого документа. Если у вас есть сотни, рассмотрите возможность создания XSLT-документа в al oop с VBA, Python, et c. Если файлы относительно малы по сравнению с опубликованными, XSLT является жизнеспособным решением, но имеет ограничения памяти.

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

<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 (не требуется l oop)

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