How to add a DocumentProperty to CustomDocumentProperties in Excel?
Try this routine:
Public Sub updateCustomDocumentProperty(strPropertyName As String, _ varValue As Variant, docType As Office.MsoDocProperties) On Error Resume Next ActiveWorkbook.CustomDocumentProperties(strPropertyName).Value = varValue If Err.Number > 0 Then ActiveWorkbook.CustomDocumentProperties.Add _ Name:=strPropertyName, _ LinkToContent:=False, _ Type:=docType, _ Value:=varValue End IfEnd Sub
Edit: Usage Examples
Five years later and the 'official' documentation is still a mess on this... I figured I'd add some examples of usage:
Set Custom Properties
Sub test_setProperties() updateCustomDocumentProperty "my_API_Token", "AbCd1234", msoPropertyTypeString updateCustomDocumentProperty "my_API_Token_Expiry", #1/31/2019#, msoPropertyTypeDateEnd Sub
Get Custom Properties
Sub test_getProperties() MsgBox ActiveWorkbook.CustomDocumentProperties("my_API_Token") & vbLf _ & ActiveWorkbook.CustomDocumentProperties("my_API_Token_Expiry")End Sub
List All Custom Properties
Sub listCustomProps() Dim prop As DocumentProperty For Each prop In ActiveWorkbook.CustomDocumentProperties Debug.Print prop.Name & " = " & prop.Value & " (" & Choose(prop.Type, _ "msoPropertyTypeNumber", "msoPropertyTypeBoolean", "msoPropertyTypeDate", _ "msoPropertyTypeString", "msoPropertyTypeFloat") & ")" Next propEnd Sub
Delete Custom Properties
Sub deleteCustomProps() ActiveWorkbook.CustomDocumentProperties("my_API_Token").Delete ActiveWorkbook.CustomDocumentProperties("my_API_Token_Expiry").DeleteEnd Sub
I figured I should extend the above answer from 2013 to work without having to pass in the docType argument:
Private Function getMsoDocProperty(v As Variant) As Integer 'VB TYPES: 'vbEmpty 0 Empty (uninitialized) 'vbNull 1 Null (no valid data) 'vbInteger 2 Integer 'vbLong 3 Long integer 'vbSingle 4 Single-precision floating-point number 'vbDouble 5 Double-precision floating-point number 'vbCurrency 6 Currency value 'vbDate 7 Date value 'vbString 8 String 'vbObject 9 Object 'vbError 10 Error value 'vbBoolean 11 Boolean value 'vbVariant 12 Variant (used only with arrays of variants) 'vbDataObject 13 A data access object 'vbDecimal 14 Decimal value 'vbByte 17 Byte value 'vbUserDefinedType 36 Variants that contain user-defined types 'vbArray 8192 Array 'OFFICE.MSODOCPROPERTIES.TYPES 'msoPropertyTypeNumber 1 Integer value. 'msoPropertyTypeBoolean 2 Boolean value. 'msoPropertyTypeDate 3 Date value. 'msoPropertyTypeString 4 String value. 'msoPropertyTypeFloat 5 Floating point value. Select Case VarType(v) Case 2, 3 getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeNumber Case 11 getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeBoolean Case 7 getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeDate Case 8, 17 getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeString Case 4 To 6, 14 getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeFloat Case Else getMsoDocProperty = 0 End SelectEnd FunctionPublic Sub subUpdateCustomDocumentProperty(strPropertyName As String, _ varValue As Variant, Optional docType As Office.MsoDocProperties = 0) If docType = 0 Then docType = getMsoDocProperty(varValue) If docType = 0 Then MsgBox "An error occurred in ""subUpdateCustomDocumentProperty"" routine", vbCritical Exit Sub End If On Error Resume Next Wb.CustomDocumentProperties(strPropertyName).Value _ = varValue If Err.Number > 0 Then Wb.CustomDocumentProperties.Add _ Name:=strPropertyName, _ LinkToContent:=False, _ Type:=docType, _ Value:=varValue End IfEnd Sub