none
Delete several OL appointments ?? RRS feed

  • Question

  • Hi all,
    I have 27 appointments (OL 2007) over one year all with subject "Subject1_" or "Subject2_"


    If I run the following code all 27 appintments are found and print out into the debug window. -> OK

    BUT if i remove the one now commented line to delete the found appointments it will not found all ?!.
    Means I have to run the code several times.
    Fist time he 'finds' 10 appointments, second time 7, third time 3, forth time 2, fifth time 1 ???
    Has anyone an idea why ??

    TIA
    acki4711

        Dim olApp As Object
        Dim olNs As Object
        Const olFldrCalendar As Long = 9
        Dim olApt As Object
       
        'init
        Set olApp = CreateObject("Outlook.Application")
        Set olNs = olApp.GetNamespace("MAPI")
        Set olFldr = olNs.GetDefaultFolder(olFldrCalendar)
      
        For Each olApt In olFldr.Items
            If TypeName(olApt) = "AppointmentItem" Then
                If Trim(olApt.Subject) = "Subject1_" Or Trim(olApt.Subject) = "Subject2_" Then
                    If olApt.Start >= dtStart And olApt.End <= dtEnd Then
                        Debug.Print "-> "; olApt.Subject + " " + CStr(olApt.Start)
    '                    olApt.Delete
                        DoEvents
                    End If
                End If
            End If
       
        Next olApt
       
        'cleanup
        Set olFldr = Nothing
        Set olNs = Nothing
        Set olApp = Nothing


    • Edited by acki4711 Wednesday, January 11, 2012 3:33 PM
    Wednesday, January 11, 2012 3:26 PM

Answers

  • You have to think of as a object container where the reset sequence elements scrubbing the list.
    FOR loops use going back.

     

    '.....
    Dim x&
        For x = olFldr.Items.Count To 1 step -1
            olApt = olFldr.Items(x)
            If TypeName(olApt) = "AppointmentItem" Then
                If Trim(olApt.Subject) = "Subject1_" Or Trim(olApt.Subject) = "Subject2_" Then
                    If olApt.Start >= dtStart And olApt.End <= dtEnd Then
                        Debug.Print "-> "; olApt.Subject + " " + CStr(olApt.Start)
    '                    olApt.Delete
                        DoEvents
                    End If
                End If
            End If
       
        Next olApt
    '.....
    


     


    Oskar Shon, Office System MVP

    Press if Helpful; Answer when a problem solved


    • Edited by VBAToolsMVP Wednesday, January 11, 2012 4:07 PM thats better
    • Marked as answer by acki4711 Thursday, January 12, 2012 8:10 AM
    Wednesday, January 11, 2012 4:05 PM