14

I'm trying to add a DocumentProperty to the CustomDocumentProperties collection. Code as follows:

Sub testcustdocprop()
Dim docprops As DocumentProperties
Dim docprop As DocumentProperty

Set docprops = ThisWorkbook.CustomDocumentProperties
Set docprop = docprops.Add(Name:="test", LinkToContent:=False, Value:="xyz")

End Sub

Running this gives me the following error:

Run-time error '5':
Invalid procedure call or argument

I tried running it with .Add as a void function, like so:

docprops.Add Name:="test", LinkToContent:=False, Value:="xyz"

This gave me the same error. How do I add a custom document property?

Community
  • 1
  • 1
sigil
  • 9,370
  • 40
  • 119
  • 199
  • 2
    Chip Pearson has written a useful set of functions to get and set document properties, available as downloadable code [here](http://www.cpearson.com/excel/docprop.aspx). – chuff Feb 13 '13 at 21:23

2 Answers2

21

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 If
End 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#, msoPropertyTypeDate
End 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 prop
End Sub

Delete Custom Properties

Sub deleteCustomProps()
    ActiveWorkbook.CustomDocumentProperties("my_API_Token").Delete
    ActiveWorkbook.CustomDocumentProperties("my_API_Token_Expiry").Delete
End Sub
ashleedawg
  • 20,365
  • 9
  • 72
  • 105
Peter Albert
  • 16,917
  • 5
  • 64
  • 88
  • 1
    I see--I was missing the `Type` argument. The intellisense showed it as optional, so I assumed it would default to Variant. Thanks! – sigil Feb 13 '13 at 21:33
  • 3
    @sigil Not only intellisense shows it as optional, it's also [documented as optional](http://office.microsoft.com/en-au/excel-help/HV080558571.aspx). Turns out it's not. This happens sometimes. – GSerg Feb 13 '13 at 22:12
  • 1
    This method works well with one caveat: If a custom property already exists and you attempt to assign it a different `MsoDocProperties` data type (e.g. change a string value with type `msoPropertyTypeString` to a number with type `msoPropertyTypeNumber`) this will error out unless you delete the custom document property first. I use a modified version of this that checks if a custom property exists, and if so, deletes it before adding a new value. – ChrisB Oct 03 '19 at 00:48
  • Still documented as optional: https://learn.microsoft.com/en-us/office/vba/api/office.documentproperties.add – Uli Gerhardt Oct 14 '21 at 11:15
8

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 vbInteger, vbLong
            getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeNumber
        Case vbBoolean
            getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeBoolean
        Case vbDate
            getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeDate
        Case vbString, vbByte
            getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeString
        Case vbSingle, vbDouble, vbCurrency,vbDecimal
            getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeFloat
        Case Else
            getMsoDocProperty = 0
    End Select
End Function

Public Sub subUpdateCustomDocumentProperty(ByVal doc as object, ByVal strPropertyName As String, _
    ByVal varValue As Variant, Optional ByVal 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
    doc.CustomDocumentProperties(strPropertyName).Value _
        = varValue
    If Err.Number > 0 Then
        doc.CustomDocumentProperties.Add _
            Name:=strPropertyName, _
            LinkToContent:=False, _
            Type:=docType, _
            Value:=varValue
    End If
End Sub
Sancarn
  • 2,575
  • 20
  • 45