Извлечение определенных данных из нескольких файлов XML в Excel

Question

У меня есть более 1000 XML-файлы, все с разными данными, но одни и те же теги

<Title> 
    <LocalTitle>12 Years a Slave</LocalTitle> 
    <OriginalTitle>12 Years a Slave</OriginalTitle> 
    <ProductionYear>2013</ProductionYear> 
    <Added>23/05/2015 15:42:03</Added> 
    <IMDBrating>8,1</IMDBrating> 
    <ContentRating>R</ContentRating> 
    <MPAARating>R</MPAARating> 
    <IMDB>tt2024544</IMDB> 
    <IMDbId>tt2024544</IMDbId> 
    <TMDbId>76203</TMDbId> 
    <Budget>20000000</Budget> 
    <Revenue>187</Revenue> 
    <Language>English</Language> 
    <LanguageCode>en</LanguageCode> 
    <Country>GB</Country> 
    <RunningTime>134</RunningTime> 
    <Overview>In the antebellum United States,</Overview> 
    <Genres> 
     <Genre>Biography</Genre> 
     <Genre>Drama</Genre> 
     <Genre>History</Genre> 
    </Genres> 
</Title> 

нужно только извлечь определенные теги из всех моих файлов XML в excel file (как только LocalTitle, ProductionYear, IMDBRating и IMDBId) Как я могу это сделать, не тратя часы на копирование и вставку?

Answer 1

Пересмотреть XSLT. Объект Excel VBA MSXML поддерживает процессор XSLT 1.0. Кроме того, Excel может импортировать преобразованный XML непосредственно в книгах с OpenXML методом:

XSLT(за исключением наружно .xsl называться ниже, возвращает только нужные теги)

<xsl:transform xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0"> 
<xsl:output version="1.0" encoding="UTF-8" indent="yes" /> 
<xsl:strip-space elements="*"/> 

    <xsl:template match="Title"> 
    <xsl:copy> 
     <xsl:apply-templates select="LocalTitle|ProductionYear|IMDBrating|IMDbId"/> 
    </xsl:copy> 
    </xsl:template> 

    <xsl:template match="*"> 
    <xsl:copy-of select="."/> 
    </xsl:template> 

</xsl:transform> 

VBA

Public Sub XSLTransform() 
On Error GoTo ErrHandle 
    ' ADD MSXML v6.0 REFERENCE ' 
    Dim xmldoc As New MSXML2.DOMDocument60 
    Dim xslDoc As New MSXML2.DOMDocument60 
    Dim newDoc As New MSXML2.DOMDocument60 
    Dim newwkb As Workbook 

    ' LOAD XML AND XSL FILES ' 
    xslDoc.async = False 
    xmldoc.Load "C:\Path\To\Input.xml" 

    xslDoc.async = False 
    xslDoc.Load "C:\Path\To\XSLTScript.xsl" 

    ' TRANSFORM XML ' 
    xmldoc.transformNodeToObject xslDoc, newDoc 
    newDoc.Save "C:\Path\To\Output.xml" 

    ' IMPORT TRANSFORMED XML ' 
    Set newwkb = Workbooks.OpenXML("C:\Path\To\Output.xml", , xlXmlLoadImportToList) 

    Exit Sub 

ErrHandle: 
    MsgBox Err.Number & " - " & Err.Description, vbCritical 
    Err.Raise xslDoc.parseError.ErrorCode, , xslDoc.parseError.reason 
    Exit Sub 

End Sub 

XML Выход

<?xml version="1.0" encoding="UTF-8"?> 
<Title> 
    <LocalTitle>12 Years a Slave</LocalTitle> 
    <ProductionYear>2013</ProductionYear> 
    <IMDBrating>8,1</IMDBrating> 
    <IMDbId>tt2024544</IMDbId> 
</Title>