我有一个包含多个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
考虑XSLT,这是一种转换XML文件的专用语言,您可以使用它的document()
函数来组合目录中的所有XML。然后,将转换后的文件作为一个文档导入Excel。Office VBA可以使用MSXML库运行XSLT1.0。
以下假设在所有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:PathToAny.xml"
xslDoc.async = False
xslDoc.Load "C:PathToScript.xsl"
xslDoc.setProperty "AllowDocumentFunction", True
' TRANSFORM XML
xmldoc.transformNodeToObject xslDoc, newDoc
newDoc.Save "C:PathToTransformed.xml"
Set xWb = Workbooks.OpenXML("C:PathToTransformed.xml")
xWb.SaveAs "C:PathToFinal.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