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

Question

我最近发现自己无法在Word中添加控件内容对象，这些对象链接到链接到SharePoint库的文档属性，这些属性在SharePoint库中创建新列时公开。

我发布了我的第一个问题：MS Word通过VBA将自定义文档属性(来自SharePoint(添加为ContentControl。不幸的是，我无法在那里发布我的解决方案，因为有些人认为我的问题不完整。

幸运的是，一位用户(@slowtlysnarky(好心地发布了一个解决方案来解决我的部分问题；内置的"；属性->QuickPart->文档属性下拉列表？。

Answer 1

以下是我将内容控件链接到从SharePoint库继承的文档属性的方法(为用户定义列提供了一个示例(。

根据@slowtlysnarky提供的解决方案，我不清楚如何找到文档属性的.XMLMapping.SetMapping路径。

为了找到这些信息，我做了以下操作：

1. 在我的SharePoint库中创建一个MS Word文件(包含一些用户列(
2. 手动在word文件中插入控制内容(见原始问题(
3. 保存文件
4. 将word文件扩展名更改为.zip
5. 提取档案中包含的文档
6. 用我最喜欢的XML编辑器打开文件
7. 然后，您可以在以下元素\attributes中找到文档的常规路径：<w:dataBinding w:prefixMappings="[rootOfProperties]" w:xpath="[pathToProperties]" ....>
   • 在我的情况下，我有：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'"
   • w:prefixMappings属性对于所有属性都是相同的。它可能会因不同的库而更改(待验证(
   • CCD_ 5属性对于每个属性都是不同的；XML映射"；(截图见原问题(
   • 我也意识到，不幸的是，一旦在SharePoint中创建了列，无论名称是否在SharePoint中更改，XML映射中的名称都不会更改，这是意料之中的事。因此，您可以在下面的代码中看到，在某些情况下，我的属性映射与最终SharePoint中所需的给定名称不同经验教训是，在创建库列之前，最好仔细考虑命名约定
8. 有了这些信息，我修改了@slowtlysnarky在我的普通模板中作为VBA宏提供的代码，一切都正常了

为了帮助他人，下面是我的代码，它改编自@slowtlysnarky。请注意，您需要根据库设置进行调整，如上所述。*更改进入：Sub setSharepointProps()*您需要更改：从document.xml中提取的sharePointPropsMappings=[rootOfProperties]和.XMLMapping.SetMapping [pathToProperties](见上文(

' 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