Set and Get a Custom Document Property

[Sisyphus]

Custom Document Properties can be used to permanently store data in a workbook without showing them in any of the worksheets. Common uses are the record of the last update, the current status of a process that is controlled by or in the workbook or the name of the person who made a particular entry. For such purposes the procedure SetProperty is required which simply assigns a given value to the specified property.

Code: Select all

Private Sub SetProperty(ByVal Prop As String, _
                        ByVal Pval As Variant, _
                        Optional ByVal Ptyp As Long = msoPropertyTypeString)
    ' assign value Pval to the CustomDocumentProperty Prop
    ' If Prop doesn't exist it will be created

    If Pval = "" Then Pval = Chr(32)
    With ThisWorkbook.CustomDocumentProperties
        On Error Resume Next
        .Item(Prop).Value = Pval
        If Err Then
            .Add Name:=Prop, _
                 LinkToContent:=False, _
                 Type:=Ptyp, _
                 Value:=Pval
        End If
    End With
End Sub

Say, you have a custom property called "LastUpdate" which is of date type. Using the above procedure you can assign a value to that property with code like this:-

Code: Select all

SetProperty "LastUpdate", Date, msoPropertyTypeDate

The last argument (msoPropertyTypeDate) is optional. It will be ignored unless the property "LastUpdate" doesn't exist in the workbook where the code is run. In that case the procedure creates it and then assigns the desired value. By default, the property will be created as Text (msoPropertyTypeString) type. Since you want to store a date the type has to be specified.

You may wish to run an update once a month, say on the first day. In that case you may wish to retrieve the date of the previous update and then decide upon your actions after comparing it with today's date. For this purpose you would need the following function.

Code: Select all

Private Function GetProperty(ByVal Prop As String, _
                             Optional ByVal DefaultVal As Variant, _
                             Optional ByVal Ptyp As Long = msoPropertyTypeString) _
                             As Variant
    ' return the value of CustomDocumentProperty Prop
    ' If Prop doesn't exist it will be created
    ' using DefaultVal and Ptyp which are otherwise ignored

    Dim Pval As Variant
   
    With ThisWorkbook.CustomDocumentProperties
        On Error Resume Next
        Pval = .Item(Prop).Value
        If Err Then
            Pval = DefaultVal
            SetProperty Prop, Pval, Ptyp
        End If
    End With
    GetProperty = Pval
End Function

Calling this function is very similar to calling the SetProperty procedure except that it returns a value.

Code: Select all

Dim LastUpdate As Date
LastUpdate = GetProperty("LastUpdate")

If the challenged property doesn't exist this call will cause GetProperty to create it. Since the call doesn't include any instructions in this regard the new property will be created as Text type and with a blank space as its value (Note: The value can't be a NullString). If you need to build for the possibility that the property doesn't exist you may specify another type and another default both of which will be totally ignored if the property is found to exist. In the context of the example I have used so far your call might rather look like this:-

Code: Select all

Dim LastUpdate As Date
LastUpdate = GetProperty("LastUpdate", Date, msoPropertyTypeDate)

You would use the simpler form only if you have called the same function in other contexts within the same project before and therefore know that the property exists or if the defaults are what you want anyway.

BTW, Custom Document Properties are found in the Custom tab of the workbook Properties dialog box. In Excel versions 2007 and later you find this tab at File/Info -> Properties -> Advanced properties.