A
Alan Silver
Hello,
I am automating Outlook 97 from Word 97. I have the EntryID of an
appointment item stored in a custom property in Word, and use this to
get hold if the appt item so I can update it.
I have code like ...
Set omNamespace = omOutlookApplication.GetNamespace("MAPI")
On Error Resume Next
Set omApptItem = omNamespace.GetItemFromID(slCalID)
The "On Error" line is there in case the item doesn't exist.
The problem is that the GetItemFromID call returns an empty item. That
means that it doesn't raise an error, implying that it found the appt
item, but the returned item object does not have any of the correct
data. The subject is empty, the start and end dates are set to
"00:00:00" and so on.
Any idea why ? The appt item definitely exists and the ID is correct.
For those who wish to see it, the full code is below. This code lives in
Word and is supposed to ensure that the user cannot close the Word doc
without having a pending calendar item for the document. All seems to
work fine, except for this one problem of getting an existing item.
TIA for any help.
Full code ...
(note that frmGetDate is a user form that gets a subject and date for
the appt item. These are stored in the module variables smSubject and
tmDueDate)
Private Sub Document_Close()
Dim olItem As Variant
Dim i As Long, j As Long
Dim slCalID As String
Dim flGetDate As frmGetDate
' check the properties for the calendar ID
Set omDocProps = ActiveDocument.CustomDocumentProperties
On Error Resume Next
' see if the property exists. If not, an error will be raised
slCalID = omDocProps.Item("CalendarItemID").Value
' delete the item (if it exists). Errors will be ignored if it doesn't exist.
omDocProps.Item("CalendarItemID").Delete
ActiveDocument.Saved = False ' force a save
ActiveDocument.Save
On Error GoTo 0
' so now we know there isn't a property for the ID.
' If there is already a calendar item, slCalID will be non-empty
' Only do the business if we are not editing the template
If Right(ActiveDocument.Name, 4) <> ".dot" Then
' editing a real document.
On Error Resume Next
ActiveDocument.Save
If Err.Number <> 0 Then
' the reason for the error-checking is that if they click Cancel on the Save dialog when it is
' a new (ie not yet saved) file, the previous line will raise an error. If this is the case,
' we don't want to do the bits below, we want to jump out of the code.
Exit Sub
End If
On Error GoTo 0
' get the Outlook object
Set omOutlookApplication = GetObject("", "Outlook.Application")
If slCalID = "" Then
' we don't have a calendar ID. Prompt for a subject and date and create a calendar item
CreateCalItem
Else
' we have an existing calendar event
' get the calendar folder
Set omNamespace = omOutlookApplication.GetNamespace("MAPI")
On Error Resume Next
Set omApptItem = omNamespace.GetItemFromID(slCalID)
' sometimes the above line can't find the item. Could be that the item was deleted.
If Err.Number = -2147221233 Then
' can't find item, create a new one
On Error GoTo 0
CreateCalItem
Else
On Error GoTo 0
If omApptItem.Start <= Now Then
Set flGetDate = New frmGetDate
With flGetDate
.Caption = "Set due date for this file"
.txtSubject = omApptItem.Subject
.dtpDueDate.Value = DateAdd("d", 1, Now)
.Show
End With
' the next If is there in case they click the X button to close the form. This avoids the
' validation step
If smSubject <> "" And tmDueDate <> "00:00:00" Then
With omApptItem
.Subject = smSubject
.Start = tmDueDate
.End = tmDueDate
.Save
End With
End If
'Else
' MsgBox "Calendar item """ & omApptItem.Subject & """ is OK", vbOKOnly
End If
End If
End If
End If
End Sub
I am automating Outlook 97 from Word 97. I have the EntryID of an
appointment item stored in a custom property in Word, and use this to
get hold if the appt item so I can update it.
I have code like ...
Set omNamespace = omOutlookApplication.GetNamespace("MAPI")
On Error Resume Next
Set omApptItem = omNamespace.GetItemFromID(slCalID)
The "On Error" line is there in case the item doesn't exist.
The problem is that the GetItemFromID call returns an empty item. That
means that it doesn't raise an error, implying that it found the appt
item, but the returned item object does not have any of the correct
data. The subject is empty, the start and end dates are set to
"00:00:00" and so on.
Any idea why ? The appt item definitely exists and the ID is correct.
For those who wish to see it, the full code is below. This code lives in
Word and is supposed to ensure that the user cannot close the Word doc
without having a pending calendar item for the document. All seems to
work fine, except for this one problem of getting an existing item.
TIA for any help.
Full code ...
(note that frmGetDate is a user form that gets a subject and date for
the appt item. These are stored in the module variables smSubject and
tmDueDate)
Private Sub Document_Close()
Dim olItem As Variant
Dim i As Long, j As Long
Dim slCalID As String
Dim flGetDate As frmGetDate
' check the properties for the calendar ID
Set omDocProps = ActiveDocument.CustomDocumentProperties
On Error Resume Next
' see if the property exists. If not, an error will be raised
slCalID = omDocProps.Item("CalendarItemID").Value
' delete the item (if it exists). Errors will be ignored if it doesn't exist.
omDocProps.Item("CalendarItemID").Delete
ActiveDocument.Saved = False ' force a save
ActiveDocument.Save
On Error GoTo 0
' so now we know there isn't a property for the ID.
' If there is already a calendar item, slCalID will be non-empty
' Only do the business if we are not editing the template
If Right(ActiveDocument.Name, 4) <> ".dot" Then
' editing a real document.
On Error Resume Next
ActiveDocument.Save
If Err.Number <> 0 Then
' the reason for the error-checking is that if they click Cancel on the Save dialog when it is
' a new (ie not yet saved) file, the previous line will raise an error. If this is the case,
' we don't want to do the bits below, we want to jump out of the code.
Exit Sub
End If
On Error GoTo 0
' get the Outlook object
Set omOutlookApplication = GetObject("", "Outlook.Application")
If slCalID = "" Then
' we don't have a calendar ID. Prompt for a subject and date and create a calendar item
CreateCalItem
Else
' we have an existing calendar event
' get the calendar folder
Set omNamespace = omOutlookApplication.GetNamespace("MAPI")
On Error Resume Next
Set omApptItem = omNamespace.GetItemFromID(slCalID)
' sometimes the above line can't find the item. Could be that the item was deleted.
If Err.Number = -2147221233 Then
' can't find item, create a new one
On Error GoTo 0
CreateCalItem
Else
On Error GoTo 0
If omApptItem.Start <= Now Then
Set flGetDate = New frmGetDate
With flGetDate
.Caption = "Set due date for this file"
.txtSubject = omApptItem.Subject
.dtpDueDate.Value = DateAdd("d", 1, Now)
.Show
End With
' the next If is there in case they click the X button to close the form. This avoids the
' validation step
If smSubject <> "" And tmDueDate <> "00:00:00" Then
With omApptItem
.Subject = smSubject
.Start = tmDueDate
.End = tmDueDate
.Save
End With
End If
'Else
' MsgBox "Calendar item """ & omApptItem.Subject & """ is OK", vbOKOnly
End If
End If
End If
End If
End Sub