MS Word 通过 VBA 添加来自 SharePoint 的自定义文档属性

Question

I recently found myself unable to add Control Content objects in Word that are linked to the document properties linked to the SharePoint library which are exposed when creating new columns inside a SharePoint library.

I posted my initial question: MS Word adding Custom Document Properties (from SharePoint) as a ContentControl via VBA . Unfortunately, I cannot post my solution there as some people decided that my question was incomplete.

Luckily a user (@slightlysnarky) kindly posted a solution to address part of my question How can I replicate programmatically in VBS what Word does when I insert a "built-in" property from the Insert->QuickPart->Document Property dropdown? .

Answer 1

Here is what worked for me to link content control to the Document Properties inherited from the SharePoint library (an example is given for user-defined columns).

From the solution provided by @slightlysnarky, I was unclear how to find the .XMLMapping.SetMapping path to the document properties.

In order to find this information, I did the following:

1. Create an MS Word file in my SharePoint library (with some user columns)
2. Insert in the word file the control content manually (see original question)
3. Save the file
4. Change word file extension to.zip
5. Extract [documentName.docx.zip]\word\document.xml document contained in the archive
6. Open the file with my favorite XML editor
7. You can then find the general path of the document at the following element\attributes: <w:dataBinding w:prefixMappings="[rootOfProperties]" w:xpath="[pathToProperties]"....>
   • In my case I had: w:prefixMappings=""xmlns:ns0='http://schemas.microsoft.com/office/2006/metadata/properties' xmlns:ns1='http://www.w3.org/2001/XMLSchema-instance' xmlns:ns2='http://schemas.microsoft.com/office/infopath/2007/PartnerControls' xmlns:ns3='856dd977-5561-4031-9d6b-b2809bca48df'"
   • The w:prefixMappings attributes were identical for all properties. It might change for different libraries (to be verified)
   • The w:xpath attributes were different for each property and match the information I could find the document "XML Map" (see the original question for screenshot).
   • I realized as well that unfortunately once a column is created in SharePoint, the name will not change in the XML mapping regardless of whether the name is changed in SharePoint or not, which could be expected. Hence, you can see in the code below that I have in some cases properties which mapping differs from the desired given name in the final SharePoint. Lesson learned is that it is best to carefully think of naming convention before creating the library columns.
8. With this information, I modified the code provided by @slightlysnarky as a VBA macro inside my normal template and everything worked.

For the sake of helping others, here is my code adapted from @slightlysnarky. Note that you will need to adjust based on your library setting as explained above. * Changes go into: the Sub setSharepointProps() * You will need to change: sharePointPropsMappings=[rootOfProperties] and .XMLMapping.SetMapping [pathToProperties] as extracted from document.xml (see above)

' a simple test -  place inside the normal .dotm file VBA content
' or wherever you want the code to reside.
' for a quick test run the test() sub. It will instert a mapped control
' content in your document

Sub insertAndMapProperty(Location, PropertyName) ' As Word.Range, As String
' Location is a Word Range where you want to insert the Content Control
'
' pass the name of the element (since it does not change when you change the user interface language)

    Dim response As Integer
    
    Select Case LCase(Trim(PropertyName))
    Case "abstract"
        setCoverPageProps Location, "Abstract", "Abstract", wdContentControlText
    Case "category"
        setMSCoreProps Location, "category", "Category", wdContentControlText
    Case "company"
        setExtendedProps Location, "Company", "Company", wdContentControlText
    Case "contentstatus"
        setMSCoreProps Location, "contentStatus", "Status", wdContentControlText
    Case "creator"
        setDCoreProps Location, "creator", "Author", wdContentControlText
    Case "companyaddress"
        setCoverPageProps Location, "CompanyAddress", "Company Address", wdContentControlText
    Case "companyemail"
        setCoverPageProps Location, "CompanyEmail", "Company E-mail", wdContentControlText
    Case "companyfax"
        setCoverPageProps Location, "CompanyFax", "Company Fax", wdContentControlText
    Case "companyphone"
        setCoverPageProps Location, "CompanyPhone", "Company Phone", wdContentControlText
    Case "description"
        setDCoreProps Location, "description", "Comments", wdContentControlText
    Case "keywords"
        setMSCoreProps Location, "keywords", "Keywords", wdContentControlText
    Case "manager"
        setExtendedProps Location, "Manager", "Manager", wdContentControlText
    Case "publishdate"
        setCoverPageProps Location, "PublishDate", "Publish Date", wdContentControlDate
    Case "subject"
        setDCoreProps Location, "subject", "Subject", wdContentControlText
    Case "title"
        setDCoreProps Location, "title", "Title", wdContentControlText
    Case "pbp-projectcode"
        setSharepointProps Location, "ProjectName", "PBP-ProjectCode", wdContentControlComboBox
    Case "ectd-title"
        setSharepointProps Location, "eCTD_x002d_Title", "eCTD-Title", wdContentControlComboBox
    Case "ectd-regulator"
        setSharepointProps Location, "Regulator", "eCTD-Regulator", wdContentControlComboBox
    Case "ectd-subtype"
        setSharepointProps Location, "SubmissionType", "eCTD-SubType", wdContentControlComboBox
    Case "ectd-subseq"
        setSharepointProps Location, "eCTD_x002d_SubmissionSequence", "eCTD-SubSeq", wdContentControlComboBox
    Case "ectd-modulelabel"
        setSharepointProps Location, "eCTD_x002d_ModuleName", "eCTD-ModuleLabel", wdContentControlComboBox
    Case "ectd-sectionlabel"
        setSharepointProps Location, "SectionTitle", "eCTD-SectionLabel", wdContentControlComboBox
    Case "ectd-subsectionindex"
        setSharepointProps Location, "eCTD_x002d_SubSection_x0023_", "eCTD-SubSectionIndex", wdContentControlComboBox
    Case "ectd-subsectionlabel"
        setSharepointProps Location, "e_x002d_CTD_x002d_SubsectionLabel", "eCTD-SubsectionLabel", wdContentControlComboBox
    Case Else
        response = MsgBox("Unrecognized property name: " & PropertyName, _
                vbCritical, "Insert Document Properties")
    End Select

End Sub

Sub setCoverPageProps(Location, PropertyName, TitlePlaceHolder, ContentType)
    'Const missing = Nothing
    Const coverPageMappings = "xmlns:ns0='http://schemas.microsoft.com/office/2006/coverPageProps'"
    With Location.ContentControls.Add(ContentType)
      .Title = TitlePlaceHolder
      .XMLMapping.SetMapping "/ns0:CoverPageProperties[1]/ns0:" & PropertyName & "[1]", coverPageMappings, Nothing
      .SetPlaceholderText missing, missing, "[" & TitlePlaceHolder & "]"
      .range.Select
    End With
End Sub

Sub setSharepointProps(Location, PropertyName, TitlePlaceHolder, ContentType)
    'Const missing = Nothing
    'THis is the property corresponding to: w:prefixMappings
    Const sharePointPropsMappings = "xmlns:ns0='http://schemas.microsoft.com/office/2006/metadata/properties' xmlns:ns1='http://www.w3.org/2001/XMLSchema-instance' xmlns:ns2='http://schemas.microsoft.com/office/infopath/2007/PartnerControls' xmlns:ns3='856dd977-5561-4031-9d6b-b2809bca48df'"
    With Location.ContentControls.Add(ContentType)
      .Title = TitlePlaceHolder

      'This part is extracted from w:xpath=
      .XMLMapping.SetMapping "/ns0:properties[1]/documentManagement[1]/ns3:" & PropertyName & "[1]", sharePointPropsMappings, Nothing
      .SetPlaceholderText Nothing, Nothing, "[" & TitlePlaceHolder & "]"
      .range.Select
    End With
End Sub

Sub setDCoreProps(Location, PropertyName, TitlePlaceHolder, ContentType)
    'Const missing = Nothing
    Const DCoreMappings = "xmlns:ns0='http://purl.org/dc/elements/1.1/' xmlns:ns1='http://schemas.openxmlformats.org/package/2006/metadata/core-properties'"
    With Location.ContentControls.Add(ContentType)
      .Title = TitlePlaceHolder
      .XMLMapping.SetMapping "/ns1:coreProperties[1]/ns0:" & PropertyName & "[1]", DCoreMappings, Nothing
      .SetPlaceholderText Nothing, Nothing, "[" & TitlePlaceHolder & "]"
      .range.Select
    End With
End Sub

Sub setMSCoreProps(Location, PropertyName, TitlePlaceHolder, ContentType)
    'Const missing = Nothing
    Const MSCoreMappings = "xmlns:ns0='http://schemas.openxmlformats.org/package/2006/metadata/core-properties'"
    With Location.ContentControls.Add(ContentType)
      .Title = TitlePlaceHolder
      .XMLMapping.SetMapping "/ns0:coreProperties[1]/ns0:" & PropertyName & "[1]", MSCoreMappings, Nothing
      .SetPlaceholderText Nothing, Nothing, "[" & TitlePlaceHolder & "]"
      .range.Select
    End With
End Sub

Sub setExtendedProps(Location, PropertyName, TitlePlaceHolder, ContentType)
    'Const missing = Nothing
    Const extendedMappings = "xmlns:ns0='http://schemas.openxmlformats.org/officeDocument/2006/extended-properties'"
    With Location.ContentControls.Add(ContentType)
      .Title = TitlePlaceHolder
      .XMLMapping.SetMapping "/ns0:Properties[1]/ns0:" & PropertyName & "[1]", extendedMappings, Nothing
      .SetPlaceholderText Nothing, Nothing, "[" & TitlePlaceHolder & "]"
      .range.Select
    End With
End Sub

Sub test()
    insertAndMapProperty Selection, "eCTD-ModuleLabel"
End Sub