Question

新用户和不经常/没有经验的编码员。我在这个网站上找到了solution一段时间用于VBA宏，它为电子表格的每一行创建一个XML文件。我在档案馆工作，我们的数字存储库系统要求XML元数据文件与他们描述的文件具有相同的文件名（扩展名为.metadata）;这样系统就会将其识别为元数据而不是离散文件。为此，我们在电子表格中记录元数据，其中列标题与我们的元数据模式元素相匹配，并运行VBA宏为每行数据创建XML文件。

宏实际上非常适合从电子表格的每一行创建单个XML文件。更新元数据模式以支持重复元素后，问题就出现了。当我在具有重复列标题/元素的电子表格上运行VBA宏时，生成的XML文件仅包含来自重复元素的最后一个实例的数据。来自最后重复元素的相同数据值也应用于先前的实例。

这就是我所说的。如您所见，XML文件中重复的“RecordContributorIndividual”元素只包含电子表格中元素（第1行，第7列）的最终实例中的数据：

  ' a user is required for this class
    Public Sub New(ByVal my_user As RGOUser)
        My.Settings.selected_summoner = "huge legend"
        My.Settings.Region = "na1"
        My.Settings.Save()
        myUser = my_user
        AddHandler tmr.Elapsed, AddressOf checkMatch
        checkTimer()
    End Sub

Public Sub checkMatch()
        Console.WriteLine(Me.GetType.ToString() + "||" + System.Reflection.MethodInfo.GetCurrentMethod.ToString())
        Console.WriteLine(oneTime)
        Try
            Dim psList() As Process = Process.GetProcesses()
            For Each p As Process In psList
                '    If strLeagueProcessName = p.ProcessName) And Not boolInGame Then
                ' remove later and replace with commented line
                If oneTime Then
                    Console.WriteLine("checkMatch Success.")
                    boolInGame = True
                    oneTime = False
                    tmr.Interval = timerInsideMatch
                    tmr.Stop()
                    Try
                        autoLoad()
                    Catch ex As Exception
                    End Try
                    Return
                Else
                    Return
                End If
            Next
        Catch ex As Exception
            Console.WriteLine("checkMatch Failure. " + ex.Message)
        End Try
        boolInGame = False
        tmr.Interval = timerOutsideMatch
    End Sub

Private Sub autoLoad()
        Console.WriteLine(Me.GetType.ToString() + "||" + System.Reflection.MethodInfo.GetCurrentMethod.ToString())
        If searchMatch() Then
            Dim x As New System.Threading.Thread(AddressOf loadConfiguration)
            Dim y As New System.Threading.Thread(AddressOf loadMatch)
            Dim z As New System.Threading.Thread(AddressOf launchMinimap)
            If My.Settings.configuration_auto_load Then
                Try
                    x.Start()
                Catch ex As Exception
                End Try
            End If
            If My.Settings.loadMatch Then
                Try
                    y.Start()
                Catch ex As Exception
                End Try
            End If
            If My.Settings.launchMinimap Then
                Try
                    z.Start()
                Catch ex As Exception
                End Try
            End If
            x.Join()
            y.Join()
            z.Join()
            tmr.Start()
        End If
    End Sub

Spreadsheet Repeated Elements

我想要实现的是一个VBA代码，它不会将重复元素的最后一个单元格值应用于该元素的所有先前实例，而是将每个元素下的电子表格单元格中的实际内容拉出来。我已粘贴下面的VBA代码。我有一种感觉，问题出在“doc.getElementsByTagName”区域的某处，但我并不积极。我觉得我很亲密，但我完全陷入困境。非常感谢任何帮助！

<?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>

Answer 1

考虑使用MSXML库动态构建XML，其createElement，createNode，appendChild方法不会硬编码节点名称或文本值，而是从单元格中提取它们。然后使用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>

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

1 个答案: