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
achterdoelenAsked:
Who is Participating?
 
PashaModCommented:
Closed, 500 points refunded.
PashaMod
Community Support Moderator
0
 
Julian HansenCommented:
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.
0
 
achterdoelenAuthor Commented:
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.

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.