如何使用 VBA 将多个 XML 文件导入 Excel 而不覆盖已导入的文件
How to Import multiple XML Files into Excel with VBA without overwriting the files that have already been imported
我有一个包含多个 XML-Files 的目录。每天都有新 XML-Files 添加到目录中。
我每天都在尝试将那些 XML-Files 导入一个特定的 Excel Sheet，而不覆盖我 Excel Sheet 中的现有数据。
我已经成功导入 XML-Files。
- 问题 1：如何导入没有标题或 xml 路径的 XML-Files？
- 问题2：有没有办法只导入新数据而跳过我已经导入的文件
希望有人能帮我解决这个问题。想了很久的解决办法，自己或网上都找不到答案。
这是我的 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>
这是 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
考虑 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 图书馆。
以下假设所有 XML 文件（无论重复元素如何）都保留了准确的结构，其中每个文档都映射到根级别 <MFK_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
我有一个包含多个 XML-Files 的目录。每天都有新 XML-Files 添加到目录中。
我每天都在尝试将那些 XML-Files 导入一个特定的 Excel Sheet，而不覆盖我 Excel Sheet 中的现有数据。
我已经成功导入 XML-Files。
- 问题 1：如何导入没有标题或 xml 路径的 XML-Files？
- 问题2：有没有办法只导入新数据而跳过我已经导入的文件
希望有人能帮我解决这个问题。想了很久的解决办法，自己或网上都找不到答案。
这是我的 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>
这是 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
考虑 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 图书馆。
以下假设所有 XML 文件（无论重复元素如何）都保留了准确的结构，其中每个文档都映射到根级别 <MFK_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