Question

我正在编写一些VBA代码，以便我们更轻松地编辑我们的一些文档 - 它们会定期生成，并且总是不同的。我们从内容控件和自定义XML中获得了一些好的价值，只要它能起作用。

我已将XML定义如下（不是完整的数据集）：

<document xmlns="http://example.com/dept/doctype">
  <office>
    <address>123 Sample St</address>
    <city>Sampleville</city>
  </office>
  <customer>
    <address>456 Other St</address>
    <city>Otherville</city>
  </customer>
  <docinfo>
    <refid>XaCaXaCaX</refid>
    <docid>1</docid>
  </docinfo>
</document>

我已导入自定义XML（开发人员功能区＆gt; XML映射窗格＆gt;自定义XML部件＆gt;添加新部件...），数据存在于Word中。如果我使用该窗格插入内容控件，它可以很好地工作。

但是，这并没有按预期工作 - 添加了内容控件时，它没有绑定到自定义XML部分中的节点，因此当绑定到该节点的其他实例时，它不会更新改变：

Sub Test()
    Const sNamespace = "http://example.com/dept/doctype"
    Const sXMLOfficeAddressPath = "/document/office/address"

    Dim oParts As CustomXMLParts
    Dim oPart As CustomXMLPart
    Dim oCC As ContentControl
    Dim oRange As Range
    On Error GoTo Err_Handler

    Set oParts = ActiveDocument.CustomXMLParts.SelectByNamespace(sNamespace)
    Set oPart = ActiveDocument.CustomXMLParts.SelectByID(oParts.Item(1).ID)

    ActiveDocument.Range.InsertParagraphBefore

    Set oRange = ActiveDocument.Paragraphs(1).Range
    Set oCC = ActiveDocument.ContentControls.Add(wdContentControlText, oRange)
    oCC.XMLMapping.SetMapping sXMLOfficeAddressPath, , oPart
    oCC.Title = "Office Address"
    oCC.Color = wdColorBlack
    Exit Sub
Err_Handler:
    MsgBox (Err.Number & ": " & Err.Description)
End Sub

SetMapping永远不会抛出错误 - 它只是默默地失败。

我为此找到的每个示例都假设您在运行时添加了XML - 如果我这样做，我会获得XML的多个副本，每个添加一个字段（大约50或更多，那令人讨厌的臃肿）。

那么我应该在哪里寻找更多灵感？

Answer 1

我从未对SetMapping方法有任何好运，至少在涉及名称空间时没有。但是SetMappingByNode总是有效 - 只要xPath是正确的。

当您的xml中有一个名称空间（首选！）时，您还需要使用名称空间前缀限定xPath中的xml标记。以下示例演示了该节点以及如何检索节点并将映射设置为节点。我的示例假定CustomXMLPart已经在文档中。

Sub AddAndLinkContentControl()
    Dim ns As String, nsPrefix As String
    Dim cxp As Office.CustomXMLPart
    Dim ccLink_xPath As String
    Dim rng As word.Range
    Dim cc As word.ContentControl
    Dim ccNode As Office.CustomXMLNode

    ns = "http://example.com/dept/doctype"
    Set cxp = ActiveDocument.CustomXMLParts.SelectByNamespace(ns)(1)
    nsPrefix = cxp.NamespaceManager.LookupPrefix(ns)
    ccLink_xPath = nsPrefix & ":document/" & nsPrefix & ":office/" & nsPrefix & ":address"
    If Not cxp Is Nothing Then
        Set rng = Selection.Range
        Set cc = ActiveDocument.Contentcontrols.Add(wdContentControlText, rng)
        Set ccNode = cxp.SelectSingleNode(ccLink_xPath)
        If Not ccNode Is Nothing Then
            cc.XMLMapping.SetMappingByNode ccNode
           'cc.XMLMapping.SetMapping ccLink_xPath, , cxp 'Doesn't work with namespaces
            Debug.Print cc.XMLMapping.IsMapped
        End If
    End If
End Sub

SetMapping不会导致错误，这就是检查IsMapped属性的原因。另请注意我如何检查ccNode Is Nothing。这是因为如果赋值不成功，这也不会导致错误 - 变量对象根本就没有被初始化。这是典型的XML解析器的工作方式。

我还发现2013年的工具将内容控件映射到自定义xml部分不可靠，并且更喜欢使用代码方法。

（请注意，示例代码中的xPath不正确，它将根节点指定为产品，而不是文档，如您提供的示例xml中所示。）

Answer 2

由于an article by Abin Jaik Antony，我还找到了一种似乎有效的替代方法。我试图尽可能地减少它：

Const sNSMapping = "xmlns:ns0='http://example.com/dept/doctype'"
Const sField = "/ns0:document[1]/ns0:office[1]/ns0:address[1]"

Function InsertTextField(sField)
    On Error GoTo Err_Handler

    Dim oCC As ContentControl
    Dim oRange As Range

    Set oRange = Selection.Range
    Set oCC = ActiveDocument.ContentControls.Add(wdContentControlText, oRange)
    oCC.XMLMapping.SetMapping sField, sNSMapping

    Exit Function
Err_Handler:
    If 4605 = Err.Number Then MsgBox "Error: You can't insert a data field inside another data field. Move the cursor outside the data field and try again.", vbOKOnly + vbCritical + vbApplicationModal, "Template Error"
End Function

请注意，您现在可以使用对XML有效的任何值调用InsertTextField。 sNSMapping中的命名空间前缀需要匹配sField中使用的前缀。这意味着您可以使用任何您想要的前缀：

Const sNSMapping = "xmlns:redcar48='http://example.com/dept/doctype'"
Const sField = "/redcar48:document[1]/redcar48:office[1]/redcar48:address[1]"

或者

Const sNSMapping = "xmlns:funkytown85='http://example.com/dept/doctype'"
Const sField = "/funkytown85:document[1]/funkytown85:office[1]/funkytown85:address[1]"

Word 2013：VBA插入内容控件映射到现有自定义XML

2 个答案: