有没有人可以帮助我理解 Word 表单上 XML 映射的 VB 代码？

问题描述

此代码附加到我正在处理的字形上的宏。它没有记录在案，据我所知，它的目的是使用表单本身的内容控制字段修改或添加一个 xml 文件。我运行宏，它只是关闭了文档，而不对 Word 文件上的 xml 映射执行任何操作。

Sub SetupSections()

    
 On Error GoTo Err
    
    Dim doc As Word.Document
    Set doc = ActiveDocument
    
    doc.VBProject.References.AddFromGuid "{3F4DACA7-160D-11D2-A8E9-00104B365C9F}",1,0
    
    Dim sPathXML As String
    sPathXML = doc.Path & "\empty XML.xml"
    
    Dim present As Boolean
    present = False
    Dim cxp As Office.CustomXMLPart
    For Each part In doc.CustomXMLParts
        root = part.DocumentElement.BaseName
        If root = "certificationAuditResponse" Then
            Set cxp = part
            present = True
        End If
    Next
    
    If Not present Then
        Set cxp = doc.CustomXMLParts.add
        cxp.Load sPathXML
    End If

    Dim ctrl As Word.ContentControl


    Dim rng As Word.Range
    
    Dim controls As ContentControls
    Dim item As ContentControl
     
    Dim rIndex As Integer
    Dim sectionMajor As String
    Dim oldSection As String
    Dim sectionMinor As String
    Dim tag As String
    oldSection = "old section"
    Dim node As CustomXMLNode
    Dim sectionNode As CustomXMLNode
    Dim responseNode As CustomXMLNode
    
    For Each tb In doc.Tables
        Dim rCount
        rCount = tb.Rows.count

        For rIndex = 1 To rCount
            Set rw = tb.Rows(rIndex)
            If rIndex = 1 Then
                sectionMajor = sectionMajorFromString(rw.Cells(1).Range.text)
                If sectionMajor = "" Then
                    GoTo NextIteration
                End If
                If Not sectionMajor = oldSection Then
                    oldSection = sectionMajor
                    Set node = cxp.SelectSingleNode("/certificationAuditResponse/responseBody")
                    node.AppendChildNode ("auditResponseSection")
                    Set sectionNode = node.LastChild
                    sectionNode.AppendChildNode "sectionName",msoCustomXMLNodeAttribute,sectionMajor
                End If
            End If
            If rIndex > 2 And rw.Cells.count > 1 Then
                sectionMinor = sectionMinorFromString(rw.Cells(1).Range.text)
                sectionNode.AppendChildNode ("auditResponse")
                Set responseNode = sectionNode.LastChild
                responseNode.AppendChildNode "requirementName",sectionMinor
                responseNode.AppendChildNode "primaryResponse"
                Set item = rw.Cells(3).Range.ContentControls(1)
                Debug.Print item.XMLMapping.SetMapping _
                    ("/certificationAuditResponse/responseBody/auditResponseSection/auditResponse[@requirementName='" + sectionMinor + "']/primaryResponse",cxp)
                responseNode.AppendChildNode "evidence"
                Set item = rw.Cells(4).Range.ContentControls(1)
                Debug.Print item.XMLMapping.SetMapping _
                    ("/certificationAuditResponse/responseBody/auditResponseSection/auditResponse[@requirementName='" + sectionMinor + "']/evidence",cxp)
            End If
            If rIndex = rCount And rw.Cells.count = 1 Then
                sectionNode.InsertNodeBefore "sectionEvidence",sectionNode.FirstChild
                Set item = rw.Cells(1).Range.ContentControls(1)
                Debug.Print item.XMLMapping.SetMapping _
                    ("/certificationAuditResponse/responseBody/auditResponseSection[@sectionName='" + sectionMajor + "']/sectionEvidence",cxp)
            End If
        Next rIndex
NextIteration:
    Next
                
   
            
        
    
    'Debug.Print doc.SelectContentControlsByTag("sectionalEvidence1").item(1).XMLMapping.SetMapping _
    '    ("/certificationAuditResponse/responseBody/auditResponseSection[@sectionName='1.0']/sectionEvidence",cxp)
'
    'Debug.Print doc.SelectContentControlsByTag("primaryResponse11").item(1).XMLMapping.SetMapping _
    '    ("/certificationAuditResponse/responseBody/auditResponseSection/auditResponse[@requirementName='1.1']/primaryResponse",cxp)
    'Debug.Print doc.SelectContentControlsByTag("evidence11").item(1).XMLMapping.SetMapping _
    '    ("/certificationAuditResponse/responseBody/auditResponseSection/auditResponse[@requirementName='1.1']/evidence",cxp)
        
        
    


    Dim sr As Range
    For Each sr In doc.StoryRanges
        For Each item In sr.ContentControls
            item.LockContentControl = True
        Next
    Next

    Exit Sub
' Exception handling. Show the message and resume.
Err:
        doc.Close False
    
End Sub

如果有人能告诉我为什么它不做任何事情，如何修改它，或者只是告诉我它的意图是什么；那太好了。谢谢。

解决方法

由于错误，您的宏关闭了文档。注释第一行以在错误行上停止宏。

'On Error GoTo Err