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 与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…