如何使用 VBA 将多个 XML 文件导入 Excel 而不覆盖已导入的文件

Question

我有一个包含多个 XML 文件的目录。每天都有新的 XML 文件添加到目录中。

我每天都在尝试将这些 XML 文件导入到一个特定的 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 可以使用 MSXML 库运行 XSLT 1.0。

以下假设在每个文档映射到根级别<MFK_XML> 的所有 XML 文件（无论重复元素）中都保留了确切的结构。为每个文档添加到下面的<xsl:copy-of ...> 行。如果您有数百个，请考虑使用 VBA、Python 等在循环中构建 XSLT 文档。如果发布的文件相对较小，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 （不需要循环）

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