使用重复列标题转换电子表格行以使用VBA宏分离XML文件

问题描述 投票：1回答：1

这里有新用户和不经常/没有经验的编码员。我在这个网站上找到了一个solution，用于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>

Spreadsheet Repeated Elements

我想要实现的是一个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
xml excel vba excel-vba
1个回答
0
投票

考虑使用MSXML库动态构建XML及其createElement，createNode，appendChild方法，这些方法不会硬编码节点名称或文本值，而是从单元格中提取它们。然后使用Identity Transform XSLT来打印输出。无需构建文本模板以在代码中进行调整。具体来说，使用createNode，因为您需要文档xmlns="http://www.sec.state.vt.us/vtcore"中的默认命名空间：

Excel输入数据

Screenshot of Data

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>
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.