CustomDocumentProperties causes Type Mismatch Error

[David Taylor]

The last line (objDoc.CustomDocumentProperties....) of code below causes a
"Type Mismatch" Error.

Case "PJ" 'Project
Set objApp = GetObject(, "MSProject.Application")
If Err Then
Set objApp = New MSProject.Application
End If
On Error GoTo Err_SetDocProps2
objApp.FileOpen Name:=strDoc
Set objDoc = objApp.Projects(strDoc)
objDoc.CustomDocumentProperties(strPropName) = varPropVal
End Select

If the property name (strPropName) does not exist then the error handler
runs this:

objDoc.CustomDocumentProperties.Add Name:=strPropName, _
LinkToContent:=False, _
Value:=varPropVal, _
Type:=intPropType
objDoc.Saved = False
objDoc.Save
objDoc.Close
objApp.Visible = False

which also causes a Type mismatch error.

Thanks in advance for your thoughts, suggestions and advice.

DT

Sub SetDocProps2(strDoc As String, strDocApp As String, strPropName As
String, varPropVal As Variant)
Dim intPropType As Integer
Dim objApp, objDoc As Object
Dim bolNewProp As Boolean

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

bolNewProp = False
On Error Resume Next
Select Case strDocApp
Case "WD" 'Word
Set objApp = GetObject(, "Word.Application")
If Err Then
Set objApp = New Word.Application
End If
On Error GoTo Err_SetDocProps2
Set objDoc = objApp.Documents.Open(FileName:=strDoc,
Visible:=False)
objDoc.CustomDocumentProperties(strPropName) = varPropVal
'objApp.Visible = False
Case "SS" 'Excel
Set objApp = GetObject(, "Excel.Application")
If Err Then
Set objApp = New Excel.Application
End If
On Error GoTo Err_SetDocProps2
Set objDoc = objApp.Workbooks.Open(FileName:=strDoc)
objDoc.CustomDocumentProperties(strPropName) = varPropVal
'objApp.Visible = False
Case "PR" 'PowerPoint
Set objApp = GetObject(, "Powerpoint.Application")
If Err Then
Set objApp = New PowerPoint.Application
End If
On Error GoTo Err_SetDocProps2
'objApp.Visible = True
Set objDoc = objApp.Presentations.Open(FileName:=strDoc,
withwindow:=msoFalse)
objDoc.CustomDocumentProperties(strPropName) = varPropVal
Case "PJ" 'Project
Set objApp = GetObject(, "MSProject.Application")
If Err Then
Set objApp = New MSProject.Application
End If
On Error GoTo Err_SetDocProps2
objApp.FileOpen Name:=strDoc
Set objDoc = objApp.Projects(strDoc)
objDoc.CustomDocumentProperties(strPropName) = varPropVal
End Select

If bolNewProp Then
objDoc.CustomDocumentProperties.Add Name:=strPropName, _
LinkToContent:=False, _
Value:=varPropVal, _
Type:=intPropType
objDoc.Saved = False
objDoc.Save
objDoc.Close
objApp.Visible = False
End If
Exit_SetDocProps2:
Set objDoc = Nothing
Set objApp = Nothing
Exit Sub

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

End Sub

 

[Mike Glen]

Hi David,

Try posting on the developer newsgroup as this one is closing down. Please
see FAQ Item: 24. Project Newsgroups. FAQs, companion products and other
useful Project information can be seen at this web
address:http://project.mvps.org/faqs.htm .

Mike Glen
Project MVP