How to add a DocumentProperty to CustomDocumentProperties in Excel?

Question

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

Sub testcustdocprop()
Dim docprops As DocumentProperties
         


        

Answer 1

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 Select
End Function

Public 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 If
End Sub