Custom Document Properties do not persist

[David Taylor]

My Access app includes a subroutine that sets custom document properties in
the following manner -

The code below tries to retrieve a custom document property:

wrdDoc.CustomDocumentProperties(strPropName) = varPropVal

If the property does not exist the error handler sets the bolNewProp flag to
true:

Err_SetDocProps:
Select Case Err
Case 5
bolNewProp = True
Resume Next

which causes the custom property to be added:

wrdDoc.CustomDocumentProperties.Add Name:=strPropName, _
Type:=intPropType, _
Value:=varPropVal, _
LinkToContent:=False

This code runs without untrapped errors and I can even see the added custom
property:

?wrddoc.customdocumentproperties("MyVersionDate").value

But when I open the word document (or view its properties in Explorer) I
find that the custom property that was added has disppeared. I would
appreciate comments, commiserations and, yes a
little help.

Thanks,

DT

Sub SetDocProps(strDoc As String, strPropName As String, varPropVal As
Variant)
Dim intPropType As Integer
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim bolNewProp As Boolean

On Error Resume Next
Set wrdApp = GetObject(, "Word.Application")
If Err Then
Set wrdApp = New Word.Application
End If
On Error GoTo Err_SetDocProps

Select Case VarType(varPropVal)
Case vbInteger, vbLong
intPropType = msoPropertyTypeNumber
Case vbBoolean
intPropType = msoPropertyTypeBoolean
Case vbDate
intPropType = msoPropertyTypeDate
Case vbSingle, vbDouble
intPropType = msoPropertyTypeFloat
Case vbString
intPropType = msoPropertyTypeString
End Select

wrdApp.Visible = False
bolNewProp = False
Set wrdDoc = Word.Documents.Open(FileName:=strDoc)
wrdDoc.CustomDocumentProperties(strPropName) = varPropVal
If bolNewProp Then
wrdDoc.CustomDocumentProperties.Add Name:=strPropName, _
Type:=intPropType, _
Value:=varPropVal, _
LinkToContent:=False
End If
Exit_SetDocProps:
wrdDoc.Save
wrdDoc.Close
Set wrdApp = Nothing
Exit Sub

Err_SetDocProps:
Select Case Err
Case 5
bolNewProp = True
Resume Next
Case 5174
MsgBox strDoc & " is not a valid file name.", vbOKOnly, "DocuMAN
Error"
Resume Exit_SetDocProps
Case Else
MsgBox Err.Description
Resume Exit_SetDocProps
End Select

End Sub

[Cindy M.]

The duplicate question has been discussed and answered in
the Word.Programming newsgroup

Cindy Meister