Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
194 views
in Technique[技术] by (71.8m points)

vba - Is there anybody who can help me understand VB code for an XML map on a Word form?

This code is attached to a macro on a word form I am working on. It is not documented and from what I can see, it is meant to either modify or add an xml file using the content control fields on the form itself. I run the macro and it just closes the doc without doing anything to the xml map on the Word file.

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", , msoCustomXMLNodeAttribute, 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

If anybody can tell me why it doesn't do anything, how to modify it, or just tell me what it is meant to do; that would be great. Thanks.

question from:https://stackoverflow.com/questions/65840620/is-there-anybody-who-can-help-me-understand-vb-code-for-an-xml-map-on-a-word-for

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

Your macro closes document due to error. Comment first line to stop macro on an error line.

'On Error GoTo Err

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...