Browse All Articles > CustomDocumentProperties class
I routinely try to process CustomDocumentProperties using the VBA interface adding, modifying and deleting according to some other code. In a recent question on EE the need to address data types was indicated to ensure change data was of the correct or at least a compatible type.
My past approach has been to use functions defined in a normal module but it made me think about using a class for the purpose and this is therefore my attempt at a class for vba control of custom document properties. Note the specific policy was to prevent errors and therefore except when essential components being omitted then there will be no errors reported. For example if you try to delete a property that does not exist then there will be no resultant error.
The methods supported are:
propAdd – add a property, if pre-exists then no action
propDelete – delete a property, if not found then no error
propUpdate – updates an existing property, if not found then no action
propWrite – forces a write, creates if necessary and changes to a compatible data type if required
Initialisation requirements:
setDoc – identifies the document that the property relates to
setNewPropValue – A value to be posted to the property
setPropName – the name of the property to be processed
Interrogatives:
getExists – Does the property exist?
getPropName – name of the property, provided for the test interface
getPropType – the data type of the property
getPropValue – the value currently stored in the document
To create a class, in your application(s) of choice and in the VBE, (if you are not familiar with the VB Editor I would suggest the article is inappropriate for you) :
Insert Class Module
Rename the class module, in the test below class name clsCustomDocumentProperty is assumed. Insert the code for the class as follows
Use the class in your application by declaring and instantiating a variable to the class and setting the key parameters, for example the document, (setDoc) excel/word/powerpoint etc., where the customdocumentproperties should reside and the name of the property you are interested in, (setPropName). Additionally if setting to a value then you need to set the new datum, (setNewPropValue).
Some example uses are as in the subsequent example scripts.
Chris
My past approach has been to use functions defined in a normal module but it made me think about using a class for the purpose and this is therefore my attempt at a class for vba control of custom document properties. Note the specific policy was to prevent errors and therefore except when essential components being omitted then there will be no errors reported. For example if you try to delete a property that does not exist then there will be no resultant error.
The methods supported are:
propAdd – add a property, if pre-exists then no action
propDelete – delete a property, if not found then no error
propUpdate – updates an existing property, if not found then no action
propWrite – forces a write, creates if necessary and changes to a compatible data type if required
Initialisation requirements:
setDoc – identifies the document that the property relates to
setNewPropValue – A value to be posted to the property
setPropName – the name of the property to be processed
Interrogatives:
getExists – Does the property exist?
getPropName – name of the property, provided for the test interface
getPropType – the data type of the property
getPropValue – the value currently stored in the document
To create a class, in your application(s) of choice and in the VBE, (if you are not familiar with the VB Editor I would suggest the article is inappropriate for you) :
Insert Class Module
Rename the class module, in the test below class name clsCustomDocumentProperty is assumed. Insert the code for the class as follows
Private objDoc As Object
Private objApp As Object
Private strgetPropName As String
Private varProperty As Variant
Private vargetPropType As MsoDocProperties
Private varCurrentgetPropValue As Variant
Private varNewgetPropValue As Variant
Private newDataTypeDate As Boolean
Private bolExists As Boolean
Private Sub Class_Initialize()
bolExists = False
End Sub
Private Sub Class_Terminate()
End Sub
Public Property Let setDoc(objDocument As Object)
Set objDoc = objDocument
Set objApp = objDocument.Application
End Property
Public Property Let setPropName(strPropName As String)
strgetPropName = strPropName
bolExists = testExists()
End Property
Public Property Let setNewPropValue(varData)
varNewgetPropValue = varData
vargetPropType = DatumMSO
End Property
Public Property Get getExists() As Boolean
getExists = bolExists
End Property
Private Property Get testExists() As Boolean
Dim prop As Variant
testExists = False
For Each prop In objDoc.CustomDocumentProperties
If LCase(prop.Name) = LCase(strgetPropName) Then
testExists = True
Set varProperty = prop
With varProperty
vargetPropType = .Type
varCurrentgetPropValue = .Value
End With
Exit For
End If
Next
End Property
Public Property Get getPropName() As String
getPropName = strgetPropName
End Property
Public Property Get getPropValue() As String
If bolExists Then
getPropValue = varCurrentgetPropValue
Else
getPropValue = ""
End If
End Property
Public Property Get getPropType() As String
If bolExists Then
getPropType = vargetPropType
Else
getPropType = ""
End If
End Property
Private Property Get getNewPropValue()
getNewPropValue = varNewgetPropValue
End Property
Private Property Get isgetNewValueTypeString() As Boolean
isgetNewValueTypeString = (TypeName(varNewgetPropValue) = "String")
End Property
Private Property Get isgetNewValueTypeDate() As Boolean
isgetNewValueTypeDate = (TypeName(varNewgetPropValue) = "Date")
End Property
Private Property Get isgetNewValueTypeNumber() As Boolean
isgetNewValueTypeNumber = (TypeName(varNewgetPropValue) = "Integer")
End Property
Private Property Get isgetNewValueTypeFloat() As Boolean
isgetNewValueTypeFloat = ((TypeName(varNewgetPropValue) = "Double") Or (TypeName(varNewgetPropValue) = "Single"))
End Property
Private Property Get isgetNewValueTypeBoolean() As Boolean
isgetNewValueTypeBoolean = (TypeName(varNewgetPropValue) = "Boolean")
End Property
Private Property Get getNewValueType() As String
getNewValueType = TypeName(varNewgetPropValue)
End Property
Private Property Get DatumMSO() As MsoDocProperties
If isgetNewValueTypeString Then
DatumMSO = msoPropertyTypeString
ElseIf isgetNewValueTypeDate Then
DatumMSO = msoPropertyTypeDate
ElseIf isgetNewValueTypeNumber Then
DatumMSO = msoPropertyTypeNumber
ElseIf isgetNewValueTypeFloat Then
DatumMSO = msoPropertyTypeFloat
ElseIf isgetNewValueTypeBoolean Then
DatumMSO = msoPropertyTypeBoolean
End If
End Property
Sub propDelete()
If bolExists Then
varProperty.Delete
bolExists = testExists()
End If
End Sub
Sub propUpdate()
If bolExists Then
If vargetPropType = DatumMSO Then
varProperty.Value = getNewPropValue
End If
End If
End Sub
Sub propWrite()
If bolExists Then
If vargetPropType = DatumMSO Then
varProperty.Value = getNewPropValue
Else
propDelete
propAdd
End If
Else
propAdd
End If
End Sub
Sub propAdd()
If Not bolExists Then
objDoc.CustomDocumentProperties.Add Name:=strgetPropName, _
LinkToContent:=False, Type:=DatumMSO, Value:=varNewgetPropValue
bolExists = testExists()
End If
End Sub
Use the class in your application by declaring and instantiating a variable to the class and setting the key parameters, for example the document, (setDoc) excel/word/powerpoint etc., where the customdocumentproperties should reside and the name of the property you are interested in, (setPropName). Additionally if setting to a value then you need to set the new datum, (setNewPropValue).
Some example uses are as in the subsequent example scripts.
Option Explicit
Sub test1()
Dim clsCDP1 As clsCustomDocumentProperty
Dim arr As Variant
Dim itm As Variant
Dim entity As Object
Set entity = GetObject(, "word.application").documents(1)
Set clsCDP1 = New clsCustomDocumentProperty
clsCDP1.setDoc = entity
clsCDP1.setPropName = "fred"
Debug.Print clsCDP1.getPropName & " Exists :> " & clsCDP1.getExists
With New clsCustomDocumentProperty
.setDoc = entity
.setPropName = "fred"
.setNewPropValue = "Temp val!"
.propAdd
Debug.Print .getPropName & " Exists :> " & .getExists
.propDelete
Debug.Print .getPropName & " Exists :> " & .getExists
End With
arr = Array(22, 22.1, "fred", CDate("22 Feb 1922"), True)
For Each itm In arr
With New clsCustomDocumentProperty
.setDoc = entity
.setPropName = "fred"
.setNewPropValue = itm
.propAdd
.propUpdate
Debug.Print "'" & .getPropName & "' New data type (" & itm & ") updated? :> " & (.getPropValue = itm)
End With
Next
arr = Array(22, 22.1, "fred", CDate("22 Feb 1922"), True)
For Each itm In arr
With New clsCustomDocumentProperty
.setDoc = entity
.setPropName = "fred"
.setNewPropValue = itm
.propWrite
Debug.Print "'" & .getPropName & "' New data type (" & itm & ") force written? :> " & (.getPropValue = itm)
End With
Next
With New clsCustomDocumentProperty
.setDoc = entity
.setPropName = "fred"
.propDelete
End With
Set entity = CreateObject("excel.application")
entity.workbooks.Add
entity.Visible = True
With New clsCustomDocumentProperty
.setDoc = entity.workbooks(1)
.setPropName = "fred"
.setNewPropValue = "Temp val!"
.propAdd
Debug.Print .getPropName & " Exists :> " & .getExists
.propDelete
Debug.Print .getPropName & " Exists :> " & .getExists
End With
entity.Application.displayalerts = False
entity.Quit
Set entity = CreateObject("powerpoint.application")
entity.presentations.Add
entity.Visible = True
With New clsCustomDocumentProperty
.setDoc = entity.presentations(1)
.setPropName = "fred"
.setNewPropValue = "Temp val!"
.propAdd
Debug.Print .getPropName & " Exists :> " & .getExists
.propDelete
Debug.Print .getPropName & " Exists :> " & .getExists
End With
' entity.Application.displayalerts = False
entity.Quit
End Sub
Chris
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (1)
Commented: