堆棧內存溢出
  簡體   English   中英

使用VBA宏將具有重復列標題的電子表格行轉換為單獨的XML文件

[英]Convert Rows of Spreadsheet With Repeating Column Headings to Separate XML Files Using VBA Macro

 原文  2017-12-19 20:34:09  3   1    xml/ excel/ vba/ excel-vba

問題描述

新用戶和不常/缺乏經驗的編碼器。 我在這個站點上不久找到了一個解決方案 ，該解決方案用於VBA宏，該宏為電子表格的每一行創建一個XML文件。 我在一個檔案館工作，我們的數字存儲庫系統需要XML元數據文件，這些文件的文件名與所描述的文件名相同（帶有.metadata擴展名）。 這樣系統可以將其識別為元數據而不是離散文件。 為了實現這一點，我們在具有與我們的元數據架構元素相匹配的列標題的電子表格中記錄了元數據，並運行VBA宏為每一行數據創建XML文件。

實際上，該宏非常適合從電子表格的每一行創建單獨的XML文件。 在我們更新元數據架構以支持重復元素之后，發生了問題。 當我在具有重復列標題/元素的電子表格上運行VBA宏時，生成的XML文件僅包含來自重復元素的最后一個實例的數據。 來自最后重復元素的相同數據值也將應用於先前的實例。

這就是我在說的。 如您所見，XML文件中重復的“ RecordContributorIndividual”元素僅包含來自電子表格中該元素的最終實例（第1行，第7列）的數據： 

<?xml version="1.0" encoding="UTF-8"?>
  <vtcore xmlns="http://www.sec.state.vt.us/vtcore">
    <RecordCreatorIndividual>Peter Shumlin</RecordCreatorIndividual>
    <RecordContributorIndividual>Stuck</RecordContributorIndividual>
    <RecordContributorIndividual>Stuck</RecordContributorIndividual>
    <RecordContributorIndividual>Stuck</RecordContributorIndividual>
    <RecordContributorIndividual>Stuck</RecordContributorIndividual>
    <RecordContributorIndividual>Stuck</RecordContributorIndividual>
    <RecordTitle>President Ronald Reagan Day proclamation</RecordTitle>
    <RecordDesc></RecordDesc>

電子表格重復元素

我要實現的是一個VBA代碼，該代碼不會將重復元素的最后一個單元格值應用於該元素的所有先前實例，而是取而代之的是將電子表格單元格中的實際內容拉到每個元素下。 我在下面粘貼了VBA代碼。 我覺得問題出在“ doc.getElementsByTagName”區域中，但我對此並不樂觀。 我感覺自己接近了，但完全被卡住了。 任何幫助是極大的贊賞！ 

Sub testXLSMtovtcoreXML()
 sTemplateXML = _
    "<?xml version='1.0' encoding='UTF-8'?>" + vbNewLine + _
    "<vtcore xmlns='http://www.sec.state.vt.us/vtcore'>" + vbNewLine + _
    "   <RecordCreatorIndividual>" + "   </RecordCreatorIndividual>" + "   
    <RecordContributorIndividual>" + "   </RecordContributorIndividual>" + 
    vbNewLine + _
    "   <RecordContributorIndividual>" + "   </RecordContributorIndividual>" 
    + "   <RecordContributorIndividual>" + "   
    </RecordContributorIndividual>" + vbNewLine + _
    "   <RecordContributorIndividual>" + "   </RecordContributorIndividual>" 
    + "   <RecordContributorIndividual>" + "   
    </RecordContributorIndividual>" + vbNewLine + _
    "   <RecordTitle>" + "  </RecordTitle>" + "   <RecordDesc>" + " 
    </RecordDesc>" + "  <RecordDate>" + "   </RecordDate>" + "  
    <RecordDate>" + "   </RecordDate>" + vbNewLine + _
    "   <RecordDate>" + "   </RecordDate>" + "   <RecordDate>" + "   
    </RecordDate>" + "   <RecordDate>" + "   </RecordDate>" + vbNewLine + _
    "   <Agency>" + "   </Agency>" + "   <Domain>" + "   </Domain>" + "   
    <Activity>" + "   </Activity>" + "   <RecordType>" + "   </RecordType>" 
    + vbNewLine + _
    "   <ClassificationCode>" + "   </ClassificationCode>" + "   
    <RelatedRecords>" + "   </RelatedRecords>" + "   <RelatedRecords>" + "   
    </RelatedRecords>" + vbNewLine + _
    "   <RelatedRecords>" + "   </RelatedRecords>" + "   <RelatedRecords>" + 
    "   </RelatedRecords>" + "   <RelatedRecords>" + "   </RelatedRecords>" 
    + vbNewLine + _
    "   <RecordIdentifier>" + "   </RecordIdentifier>" + "   <PublicAccess>" 
    + "   </PublicAccess>" + "   <PublicAccessCitation>" + "   
    </PublicAccessCitation>" + vbNewLine + _
    "   <PublicAccessCitation>" + "   </PublicAccessCitation>" + "   
    <PublicAccessCitation>" + "   </PublicAccessCitation>" + vbNewLine + _
    "   <PublicAccessCitation>" + "   </PublicAccessCitation>" + "   
    <PublicAccessCitation>" + "   </PublicAccessCitation>" + vbNewLine + _
    "   <Subject>" + "   </Subject>" + "   <Subject>" + "   </Subject>" + "   
    <Subject>" + "   </Subject>" + "   <Subject>" + "   </Subject>" + 
    vbNewLine + _
    "   <Subject>" + "   </Subject>" + vbNewLine + _
    "</vtcore>" + vbNewLine

 Set doc = CreateObject("MSXML2.DOMDocument")
 doc.async = False
 doc.validateOnParse = False
 doc.resolveExternals = False

 With ActiveWorkbook.Worksheets(1)
 lLastRow = .UsedRange.Rows.Count

 For lRow = 2 To lLastRow
  sFileName = .Cells(lRow, 1).Value
  sRecordCreatorIndividual = .Cells(lRow, 2).Value
  sRecordContributorIndividual = .Cells(lRow, 3).Value
  sRecordContributorIndividual = .Cells(lRow, 4).Value
  sRecordContributorIndividual = .Cells(lRow, 5).Value
  sRecordContributorIndividual = .Cells(lRow, 6).Value
  sRecordContributorIndividual = .Cells(lRow, 7).Value
  sRecordTitle = .Cells(lRow, 8).Value
  sRecordDesc = .Cells(lRow, 9).Value
  sRecordDate = .Cells(lRow, 10).Value
  sRecordDate = .Cells(lRow, 11).Value
  sRecordDate = .Cells(lRow, 12).Value
  sRecordDate = .Cells(lRow, 13).Value
  sRecordDate = .Cells(lRow, 14).Value
  sAgency = .Cells(lRow, 15).Value
  sDomain = .Cells(lRow, 16).Value
  sActivity = .Cells(lRow, 17).Value
  sRecordType = .Cells(lRow, 18).Value
  sClassificationCode = .Cells(lRow, 19).Value
  sRelatedRecords = .Cells(lRow, 20).Value
  sRelatedRecords = .Cells(lRow, 21).Value
  sRelatedRecords = .Cells(lRow, 22).Value
  sRelatedRecords = .Cells(lRow, 23).Value
  sRelatedRecords = .Cells(lRow, 24).Value
  sRecordIdentifier = .Cells(lRow, 25).Value
  sPublicAccess = .Cells(lRow, 26).Value
  sPublicAccessCitation = .Cells(lRow, 27).Value
  sPublicAccessCitation = .Cells(lRow, 28).Value
  sPublicAccessCitation = .Cells(lRow, 29).Value
  sPublicAccessCitation = .Cells(lRow, 30).Value
  sPublicAccessCitation = .Cells(lRow, 31).Value
  sSubject = .Cells(lRow, 32).Value
  sSubject = .Cells(lRow, 33).Value
  sSubject = .Cells(lRow, 34).Value
  sSubject = .Cells(lRow, 35).Value
  sSubject = .Cells(lRow, 36).Value

 doc.LoadXML sTemplateXML
 doc.getElementsByTagName("RecordCreatorIndividual")(0).appendChild 
 doc.createTextNode(sRecordCreatorIndividual)
 doc.getElementsByTagName("RecordContributorIndividual")(0).appendChild 
 doc.createTextNode(sRecordContributorIndividual)
 doc.getElementsByTagName("RecordContributorIndividual")(1).appendChild 
 doc.createTextNode(sRecordContributorIndividual)
 doc.getElementsByTagName("RecordContributorIndividual")(2).appendChild 
 doc.createTextNode(sRecordContributorIndividual)
 doc.getElementsByTagName("RecordContributorIndividual")(3).appendChild 
 doc.createTextNode(sRecordContributorIndividual)
 doc.getElementsByTagName("RecordContributorIndividual")(4).appendChild 
 doc.createTextNode(sRecordContributorIndividual)
 doc.getElementsByTagName("RecordTitle")(0).appendChild 
 doc.createTextNode(sRecordTitle)
 doc.getElementsByTagName("RecordDesc")(0).appendChild 
 doc.createTextNode(sRecordDesc)
 doc.getElementsByTagName("RecordDate")(0).appendChild 
 doc.createTextNode(sRecordDate)
 doc.getElementsByTagName("RecordDate")(1).appendChild 
 doc.createTextNode(sRecordDate)
 doc.getElementsByTagName("RecordDate")(2).appendChild 
 doc.createTextNode(sRecordDate)
 doc.getElementsByTagName("RecordDate")(3).appendChild 
 doc.createTextNode(sRecordDate)
 doc.getElementsByTagName("RecordDate")(4).appendChild 
 doc.createTextNode(sRecordDate)
 doc.getElementsByTagName("Agency")(0).appendChild 
 doc.createTextNode(sAgency)
 doc.getElementsByTagName("Domain")(0).appendChild 
 doc.createTextNode(sDomain)
 doc.getElementsByTagName("Activity")(0).appendChild 
 doc.createTextNode(sActivity)
 doc.getElementsByTagName("RecordType")(0).appendChild 
 doc.createTextNode(sRecordType)
 doc.getElementsByTagName("ClassificationCode")(0).appendChild 
 doc.createTextNode(sClassificationCode)
 doc.getElementsByTagName("RelatedRecords")(0).appendChild 
 doc.createTextNode(sRelatedRecords)
 doc.getElementsByTagName("RelatedRecords")(1).appendChild 
 doc.createTextNode(sRelatedRecords)
 doc.getElementsByTagName("RelatedRecords")(2).appendChild 
 doc.createTextNode(sRelatedRecords)
 doc.getElementsByTagName("RelatedRecords")(3).appendChild 
 doc.createTextNode(sRelatedRecords)
 doc.getElementsByTagName("RelatedRecords")(4).appendChild 
 doc.createTextNode(sRelatedRecords)
 doc.getElementsByTagName("RecordIdentifier")(0).appendChild 
 doc.createTextNode(sRecordIdentifier)
 doc.getElementsByTagName("PublicAccess")(0).appendChild 
 doc.createTextNode(sPublicAccess)
 doc.getElementsByTagName("PublicAccessCitation")(0).appendChild 
 doc.createTextNode(sPublicAccessCitation)
 doc.getElementsByTagName("PublicAccessCitation")(1).appendChild 
 doc.createTextNode(sPublicAccessCitation)
 doc.getElementsByTagName("PublicAccessCitation")(2).appendChild 
 doc.createTextNode(sPublicAccessCitation)
 doc.getElementsByTagName("PublicAccessCitation")(3).appendChild 
 doc.createTextNode(sPublicAccessCitation)
 doc.getElementsByTagName("PublicAccessCitation")(4).appendChild 
 doc.createTextNode(sPublicAccessCitation)
 doc.getElementsByTagName("Subject")(0).appendChild 
 doc.createTextNode(sSubject)
 doc.getElementsByTagName("Subject")(1).appendChild 
 doc.createTextNode(sSubject)
 doc.getElementsByTagName("Subject")(2).appendChild 
 doc.createTextNode(sSubject)
 doc.getElementsByTagName("Subject")(3).appendChild 
 doc.createTextNode(sSubject)
 doc.getElementsByTagName("Subject")(4).appendChild 
 doc.createTextNode(sSubject)
 doc.Save sFileName + ".metadata"
Next

End With
End Sub

1 個解決方案

解決方案1
 0 已采納  2017-12-19 21:52:12

考慮使用MSXML庫及其createElement ， createNode和appendChild方法動態構建XML，該方法不會硬編碼節點名稱或文本值，而是從單元格中提取它們。 然后使用Identity Transform XSLT漂亮地打印輸出。 無需構建文本模板即可在代碼中進行調整。 具體來說，使用createNode是因為您需要在文檔xmlns="http://www.sec.state.vt.us/vtcore"使用默認名稱空間：

Excel輸入數據

數據截圖

VBA （使用早期綁定與MSXML參考對象） 

Option Explicit

Sub XMLExport()
On Error GoTo ErrHandle
    Dim lastCol As Long, lastRow As Long
    Dim xlrow As Long

    ' WRITE TO XML
    With ThisWorkbook.Sheets(1)
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For xlrow = 2 To lastRow
            Call BuildXML(xlrow)
        Next xlrow
    End With

    MsgBox "Successfully migrated Excel data into XML files!", vbInformation

ExitHandle:
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Resume ExitHandle

End Sub

Function BuildXML(i As Long)
On Error GoTo ErrHandle
    ' REFERENCE Microsoft XML, v6.0 UNDER TOOLS\REFERENCES
    Dim doc As New MSXML2.DOMDocument, xslDoc As New MSXML2.DOMDocument, newDoc As New MSXML2.DOMDocument
    Dim root As IXMLDOMNode, colNode As IXMLDOMNode

    Dim xslFile As String, xml_filename As String
    Dim lastCol As Long, lastRow As Long
    Dim j As Long

    ' DECLARE XML DOC OBJECT
    Set root = doc.createNode(1, "vtcore", "http://www.sec.state.vt.us/vtcore")
    doc.appendChild root

    ' WRITE TO XML
    With ThisWorkbook.Sheets(1)
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        xml_filename = Mid(.Cells(i, 1), 1, InStr(.Cells(i, 1), ".") - 1) & ".metadata"

        For j = 2 To lastCol

            Set colNode = doc.createNode(1, .Cells(1, j), "http://www.sec.state.vt.us/vtcore")
            colNode.Text = .Cells(i, j)
            root.appendChild colNode

        Next j
    End With

    ' PRETTY PRINT OUTPUT WITH INDENTATION AND LINE BREAKS
    xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _
            & "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _
            & "                xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _
            & "  <xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _
            & "  <xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _
            & "            encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _
            & "  <xsl:template match=" & Chr(34) & "node() | @*" & Chr(34) & ">" _
            & "    <xsl:copy>" _
            & "       <xsl:apply-templates select=" & Chr(34) & "node() | @*" & Chr(34) & " />" _
            & "    </xsl:copy>" _
            & "  </xsl:template>" _
            & "</xsl:stylesheet>"

    xslDoc.async = False
    doc.transformNodeToObject xslDoc, newDoc
    newDoc.Save Application.ActiveWorkbook.Path & "\" & xml_filename
    Debug.Print xml_filename

ExitHandle:
    Set doc = Nothing: Set xslDoc = Nothing: Set newDoc = Nothing
    Exit Function

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Resume ExitHandle

End Function

輸出量 

<?xml version="1.0" encoding="UTF-8"?>
<vtcore xmlns="http://www.sec.state.vt.us/vtcore">
    <FileName>16-001 President Ronald Reagan Day.pdf</FileName>
    <RecordCreatorIndividual>Peter Shumulin</RecordCreatorIndividual>
    <RecordCreatorIndividual>Help </RecordCreatorIndividual>
    <RecordCreatorIndividual>I </RecordCreatorIndividual>
    <RecordCreatorIndividual>Am</RecordCreatorIndividual>
    <RecordCreatorIndividual>Realy</RecordCreatorIndividual>
    <RecordCreatorIndividual>Stuck</RecordCreatorIndividual>
    <RecordCreatorIndividual>President Ronald Reagan Day proclamation</RecordCreatorIndividual>
</vtcore>

暫無
暫無

聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

相關問題 將電子表格的行轉換為單獨的 XML 文件 使用 XSLT 將電子表格導出到 XML 時處理重復行 使用VBA宏將Excel數據的每一行創建為xml文件 使用shell命令從重復的XML元素中提取文本以分隔文件 將列XML數據轉換為行 Can I use the Newtonsoft JSON .NET library with my Excel VBA Macro to convert JSON to XML using DeserializeXmlNode? Pandas：解析 xml 列並拆分為單獨的行 通過標題將 docx 拆分為 Python 中的單獨文件 使用VBA將XML轉換為CSV 將xml節點重復到單獨的塊中
相關標簽
 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM