![](/img/trans.png)
[英]How do you update MS Word Custom Document Properties that link-to-content using VBA?
[英]MS Word adding via VBA Custom Document Properties from SharePoint
我最近发现自己无法在 Word 中添加控制内容对象,这些对象链接到链接到 SharePoint 库的文档属性,在 SharePoint 库中创建新列时会暴露这些对象。
我发布了我最初的问题: MS Word 通过 VBA 添加自定义文档属性(来自 SharePoint)作为 ContentControl 。 不幸的是,我不能在那里发布我的解决方案,因为有些人认为我的问题不完整。
幸运的是,用户 (@slightlysnarky) 发布了一个解决方案来解决我的部分问题如何在 VBS 中以编程方式复制当我从“插入”->“快速部件”->“文档属性”下拉列表中插入“内置”属性时 Word 会做什么? .
这是我将内容控件链接到从 SharePoint 库继承的文档属性的方法(为用户定义的列提供了一个示例)。
从@slightlysnarky 提供的解决方案中,我不清楚如何找到文档属性的.XMLMapping.SetMapping
路径。
为了找到这些信息,我做了以下事情:
<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 Map”的信息相匹配(有关屏幕截图,请参见原始问题)。 为了帮助他人,这是我改编自@slightlysnarky 的代码。 请注意,您需要根据您的库设置进行调整,如上所述。 * 将 go 更改为: 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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.