Come aggiungere DocumentProperty a CustomDocumentProperties in Excel?

Question

Sto tentando di aggiungere DocumentProperty alla raccolta CustomDocumentProperties. Codice come segue:

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 

L'esecuzione di questo mi dà il seguente errore:

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

Ho provato a correre con .Add come una funzione vuoto, in questo modo:

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

Questo mi ha dato lo stesso errore. Come aggiungo una proprietà del documento personalizzato?

Answer 1

Prova questa routine:

Public Sub subUpdateCustomDocumentProperty(strPropertyName As String, _ 
    varValue As Variant, docType As Office.MsoDocProperties) 

    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 

Answer 2

ho pensato che dovrebbe estendere la risposta di cui sopra a partire dal 2013 a lavorare senza dover passare nella discussione docType:

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