How to reschule an outlook appointment with access vba?

[Vic Rensburg]

Dear All,

I have a Call Logger database with a scheduler function.
I've managed to book the appointments and set reminders in Outlook 2007 via access vba, but I'ma bit stuck in calling the appointment information via using the subject and then amending the date and time.

I would really appreciate if you couldprovide some sample code of how this possibly could be achieved. Please help.

Many thanks,

Vic

[beacon]

This isn't perfect code, but could you use something like:

For Each Appointment in objAppointments
    If Appointment.Subject = "Your Subject" Then
        Appointment.Start = #Your Start Date# & " " & #Your New Start Time#
        Appointment.Duration = #The Length of Appointment#
    Else
        'Do Nothing
    End If
Next 
 

[Vic Rensburg]

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
-------------------------------------------------------------------------------------------------------------------------------