asked on

outlook programming change apoinment

Hi,

I have to make a vba program / vb script to automatically change the start time for all apointments between two dates. So far i have this:

Dim ol As New Outlook.Application
Dim ap As AppointmentItem
Dim fldr As MAPIFolder
Dim i
Dim Datum As Date
Dim TijdUur
Dim TijdMinuutEnSeconden
Dim Teller As Integer
Dim re

Teller = 0
Set fldr = ol.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
fldr.Items.Sort ("[Start]")
For i = 1 To fldr.Items.Count
Set ap = fldr.Items(i)
Datum = CDate(Format(ap.Start, "dd-mm-yyyy"))

If ZomertijdJaNee(Datum) Then 'check if date is in range
If ap.RecurrenceState <> olApptNotRecurring Then
Set re = ap.GetRecurrencePattern
TijdUur = Format(ap.Start, "hh") - 1
TijdMinuutEnSeconden = Mid(Format(ap.Start, "hh:mm:ss"), 3) ':minuten: seconden
re.StartTime = Format(TijdUur & TijdMinuutEnSeconden, "hh:mm:ss") ' nieuwe datum tijd
ap.Save

Set re = Nothing
Else
TijdUur = Format(ap.Start, "hh") - 1
TijdMinuutEnSeconden = Mid(Format(ap.Start, "hh:mm:ss"), 3) ':minuten: seconden
ap.Start = CDate(Datum & " " & TijdUur & TijdMinuutEnSeconden) ' nieuwe datum tijd
ap.Save
End If
Else
'do nothing
End If
Teller = Teller + 1
Next
Set ap = Nothing
Set fldr = Nothing

This works for non recurring appointments, however recurring appointments change the whole series, and not just one's between the dates. How can i change just one appoinment instead of the whole series?

Outlook version is 2003.

Thanks,

Jan Dek

Julian Hansen

Some options

1. Remove the recurring appointment and recreate it for the next recurring date
2. Change the recurring appointment to start from the next recurring date and create a new appointment for the date you wanted to change
3. Create a new appointment for the new time and leave the recurring appointment

2 Is probably the best option I think you can access the start time through your ap var above.

achterdoelen

ASKER

Solved it myself.

Change program to this:

Sub Herhalen()
Dim x
Dim y
Dim ap
Set myOlApp = New Outlook.Application
Set myitems = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
' Set the IncludeRecurrences property to make sure all of the
' recurring appointments are also included in the collection.
myitems.IncludeRecurrences = True

' Sort the collection based on the start of the appointment.
myitems.Sort "[Start]"

' Display one of the recurring appointments which have
' been included.
y = myitems.Count
For x = 1 To myitems.Count
VerschuifAfspraak myitems.Item(x).Start, myitems.Item(x).ConversationTopic
If myitems.Item(x).Start > #1/1/2011# Then GoTo Einde
Next
Einde:
End Sub

Sub VerschuifAfspraak(AfspraakDatumEnTijd As Date, titel As String)

Dim ol As New Outlook.Application
Dim ap As AppointmentItem
Dim fldr As MAPIFolder
Dim i
Dim Datum As Date
Dim TijdUur
Dim TijdMinuutEnSeconden
Dim Teller As Integer
Dim Re
Dim NieuweTijd

Teller = 0
Set fldr = ol.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
fldr.Items.Sort ("[Start]")
Set ap = fldr.Items(titel)
Datum = Format(AfspraakDatumEnTijd, "dd-mm-yyyy")
If ZomertijdJaNee(Datum) Then
If ap.RecurrenceState <> olApptNotRecurring Then
Set Re = ap.GetRecurrencePattern.GetOccurrence(AfspraakDatumEnTijd)
TijdUur = Format(AfspraakDatumEnTijd, "hh") + 1
TijdMinuutEnSeconden = Mid(Format(AfspraakDatumEnTijd, "hh:mm:ss"), 3) ':minuten: seconden
NieuweTijd = CDate(Datum & " " & Format(TijdUur & TijdMinuutEnSeconden, "hh:mm:ss")) ' nieuwe datum tijd
Re.Start = NieuweTijd
Re.Save
Set Re = Nothing
Else
TijdUur = Format(AfspraakDatumEnTijd, "hh") + 1
TijdMinuutEnSeconden = Mid(Format(AfspraakDatumEnTijd, "hh:mm:ss"), 3) ':minuten: seconden
ap.Start = Datum & " " & Format(TijdUur & TijdMinuutEnSeconden, "hh:mm:ss") ' nieuwe datum tijd
ap.Save
End If
End If
Set ap = Nothing
Set fldr = Nothing

End Sub

This works like i want i to work.

ASKER CERTIFIED SOLUTION

PashaMod

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial