Outlook Reminder Problem after Re-scheduling Appointment using Access VBA

[vicsta83]

Dear All,

I'm hoping someone can help me with this problem.
I've managed to create and reschedule outlook appointments and set
reminders using Access 2007.
The problem I have is that the Reminder Pop-up window does not reflect
the new information, for example:
1.) If the reminder IsVisible in the pop-up window and the appointment
is rescheduled to a future date it remains visible and does not
reflect new appointment date.
2.) If the reminder is not Visisble in the pop-up window and I
reschedule the appointment back to past date it does not pop-up in
reminder window to alert as to still being outstanding.

Could you please advise how to synchronize these?

Many thanks,

Fincc

Here is the code I use for the "Callback or Re-schedule Callback":

------------------------------------------------------------------------------------------
'--------------------------------------
' Schedule OR Re-schedule a Callback
'--------------------------------------
Private Sub ReOrScheduleCallback()

'On Error GoTo ReOrScheduleCallback_Err

Dim OutLookReminder As Outlook.AppointmentItem
Dim objApp As Outlook.Application
Dim ObjNS As Outlook.NameSpace
Dim ObjFolder As Outlook.Folder
Dim srFilter

Set objApp = CreateObject("Outlook.Application")
Set ObjNS = objApp.GetNamespace("MAPI")
Set ObjFolder = ObjNS.GetDefaultFolder(olFolderCalendar)


srFilter = "[Mileage] = " & recordID & ""

If Not ObjFolder Is Nothing Then
Set OutLookReminder = ObjFolder.Items.Find(srFilter)

If OutLookReminder Is Nothing Then

Dim Reminder As Outlook.AppointmentItem
Set appOutLook = CreateObject("Outlook.Application")
Set Reminder = appOutLook.CreateItem(olAppointmentItem)

With Reminder
' Here create new item if not found
.Mileage = recordID
.Subject = "" & AccountField & ""
.Body = "" & Notes & ""
.ReminderSet = True
.ReminderOverrideDefault = True
.ReminderMinutesBeforeStart = 5
.Start = DateofTask & " " & AppTime
.ReminderPlaySound = True
'add the path to a .wav file on your computer.
.ReminderSoundFile = "G:\FINCC\Call Log\LogPics
\ding.wav"
.Save
End With
MsgBox "Reminder for " & AccountField & " scheduled for
" & DateofTask & " at " & AppTime & ""
Me.Account.SetFocus

Else

With OutLookReminder
' here you can get or change any of the properties of
the appointmentItem

.Mileage = recordID
.Subject = "" & AccountField & ""
.Body = "" & Notes & ""
.Start = DateofTask & " " & AppTime
.Save
.ReminderSet = True
.ReminderOverrideDefault = True
.ReminderMinutesBeforeStart = 5
.ReminderPlaySound = True
'add the path to a .wav file on your computer.
.ReminderSoundFile = "G:\FINCC\Call Log\LogPics
\ding.wav"
.Save
End With
MsgBox "Reminder Rescheduled for " & AccountField & "
scheduled for " & DateofTask & " at " & AppTime & ""
Me.Account.SetFocus
End If

Else
MsgBox "Problem Connecting with Outlook"
End If

ReOrScheduleCallback_Exit:
Exit Sub

ReOrScheduleCallback_Err:
MsgBox "Hello"
Resume ReOrScheduleCallback_Exit
End Sub
------------------------------------------------------------------------------------------





I've tried dismissing the reminder with this code below, but that
seems to delete the whole appointment (which in some instances is not
desired) :

Private Sub DismissReminder()

On Error GoTo DismissReminder_Err

'Dismisses related active reminders.

Dim olApp As Outlook.Application
Dim objRem As Reminder
Dim objRems As Reminders

Set olApp = Outlook.Application
Set objRems = olApp.Reminders


If olApp.Reminders.Count <> 0 Then
For Each objRem In objRems
If objRem.Caption = AccountField And objRem.IsVisible =
True Then

objRem.Dismiss


End If

Next

Else

' Do nothing

End If

DismissReminder_Exit:
Exit Sub

DismissReminder_Err:
MsgBox Error$
Resume DismissReminder_Exit

End Sub
-------------------------------------------------------------------------------------------------------------------------------