MS Word 通过来自 SharePoint 的 VBA 自定义文档属性添加
MS Word adding via VBA Custom Document Properties from SharePoint
我最近发现自己无法在 Word 中添加控件内容对象，这些对象链接到链接到 SharePoint 库的文档属性，这些属性在 SharePoint 库中创建新列时公开。
我 post 编辑了我最初的问题：MS Word adding Custom Document Properties (from SharePoint) as a ContentControl via VBA。不幸的是，我无法 post 我的解决方案，因为有些人认为我的问题不完整。
幸运的是，一位用户 (@slightlysnarky) 好心 post 提供了一个解决方案来解决我的部分问题 。
以下是对我 link 对从 SharePoint 库继承的文档属性进行内容控制的方法（为 user-defined 列提供了一个示例）。
从@slightlysnarky 提供的解决方案中，我不清楚如何找到文档属性的 .XMLMapping.SetMapping 路径。
为了找到这些信息，我做了以下工作：
- 在我的 SharePoint 库中创建一个 MS Word 文件（包含一些用户列）
- 在word文件中手动插入控件内容（见原题）
- 保存文件
- 将 word 文件扩展名更改为 .zip
- 提取 [documentName.docx.zip]\word\document.xml 存档中包含的文档
- 用我最喜欢的 XML 编辑器打开文件
- 然后可以在下面element\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 属性对于所有属性都是相同的。它可能会因不同的库而改变（待验证）- 每个 属性 的
w:xpath 属性都不同，并且匹配我可以找到文档“XML 地图”的信息（请参阅原始问题的屏幕截图）。
- 我也意识到，不幸的是，一旦在 SharePoint 中创建了一个列，无论名称是否在 SharePoint 中更改，XML 映射中的名称都不会更改，这是可以预料的。因此，您可以在下面的代码中看到，在某些情况下，我的属性映射与最终 SharePoint 中所需的给定名称不同。 经验教训是，最好在创建库列之前仔细考虑命名约定。
- 根据这些信息，我将@slightlysnarky 提供的代码修改为普通模板中的 VBA 宏，一切正常。
为了帮助别人，这是我改编自@slightlysnarky 的代码。请注意，您需要根据您的图书馆设置进行调整，如上所述。
* 更改进入：Sub setSharepointProps()
* 您需要更改：sharePointPropsMappings=[rootOfProperties] 和 .XMLMapping.SetMapping [pathToProperties] 摘自 document.xml（见上文）
' 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
我最近发现自己无法在 Word 中添加控件内容对象，这些对象链接到链接到 SharePoint 库的文档属性，这些属性在 SharePoint 库中创建新列时公开。
我 post 编辑了我最初的问题：MS Word adding Custom Document Properties (from SharePoint) as a ContentControl via VBA。不幸的是，我无法 post 我的解决方案，因为有些人认为我的问题不完整。
幸运的是，一位用户 (@slightlysnarky) 好心 post 提供了一个解决方案来解决我的部分问题
以下是对我 link 对从 SharePoint 库继承的文档属性进行内容控制的方法（为 user-defined 列提供了一个示例）。
从@slightlysnarky 提供的解决方案中，我不清楚如何找到文档属性的 .XMLMapping.SetMapping 路径。
为了找到这些信息，我做了以下工作：
- 在我的 SharePoint 库中创建一个 MS Word 文件（包含一些用户列）
- 在word文件中手动插入控件内容（见原题）
- 保存文件
- 将 word 文件扩展名更改为 .zip
- 提取 [documentName.docx.zip]\word\document.xml 存档中包含的文档
- 用我最喜欢的 XML 编辑器打开文件
- 然后可以在下面element\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属性对于所有属性都是相同的。它可能会因不同的库而改变（待验证）- 每个 属性 的
w:xpath属性都不同，并且匹配我可以找到文档“XML 地图”的信息（请参阅原始问题的屏幕截图）。 - 我也意识到，不幸的是，一旦在 SharePoint 中创建了一个列，无论名称是否在 SharePoint 中更改，XML 映射中的名称都不会更改，这是可以预料的。因此，您可以在下面的代码中看到，在某些情况下，我的属性映射与最终 SharePoint 中所需的给定名称不同。 经验教训是，最好在创建库列之前仔细考虑命名约定。
- 就我而言，我有：
- 根据这些信息，我将@slightlysnarky 提供的代码修改为普通模板中的 VBA 宏，一切正常。
为了帮助别人，这是我改编自@slightlysnarky 的代码。请注意，您需要根据您的图书馆设置进行调整，如上所述。
* 更改进入：Sub setSharepointProps()
* 您需要更改：sharePointPropsMappings=[rootOfProperties] 和 .XMLMapping.SetMapping [pathToProperties] 摘自 document.xml（见上文）
' 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