Results 1 to 7 of 7

Thread: VBA to delete Outlook Appointments
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Apr 2009
    Posts
    104
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default VBA to delete Outlook Appointments

    I am trying to write code that is going to add events to a calendar based on an excel sheet, but first it needs to delete any appointments that have the same subject as anything in my list. Here is my code:

    Code:
    Dim oApp As Outlook.Application
     Dim oNameSpace As Outlook.Namespace
     Dim oApptItem As Outlook.AppointmentItem
     Dim oFolder As Outlook.MAPIFolder
     Dim oMeetingoApptItem As Outlook.MeetingItem
     Dim oObject As Object
     Dim iUserReply As VbMsgBoxResult
     Dim sErrorMessage As String
     Dim j As Integer
     Dim i As Integer
     
     
     On Error Resume Next
     ' check if Outlook is running
     Set oApp = GetObject("Outlook.Application")
     If Err <> 0 Then
    'if not running, start it
       Set oApp = CreateObject("Outlook.Application")
     End If
     
     On Error GoTo Err_Handler
    
    
     Set oNameSpace = oApp.GetNamespace("MAPI")
     Set oFolder = oNameSpace.GetDefaultFolder(olFolderCalendar)
     
    On Error Resume Next
     For Each oObject In oFolder.Items
       If oObject.Class = olAppointment Then
         Set oApptItem = oObject
         For j = 2 To Range("A1").End(xlDown).Row
         If InStr(oApptItem.Subject, Range("A" & j).Value) > 0 Then
         
                oApptItem.Delete
                
         End If
         Next j
         
       End If
     Next oObject
    On Error GoTo Err_Handler
    
    
    For i = 2 To Range("A1").End(xlDown).Row
    
    
        Set oApptItem = oApp.CreateItem(olAppointmentItem)
    
    
        With oApptItem
            .Subject = Range("A" & i).Value
            .Start = Range("B" & i).Value
            .AllDayEvent = True
            .Save
            .Send
        End With
    Next i
    
    
    
    
    
    
     
     Set oApp = Nothing
     Set oNameSpace = Nothing
     Set oApptItem = Nothing
     Set oFolder = Nothing
     Set oObject = Nothing
     
     Exit Sub
     
    Err_Handler:
     MsgBox ("Error running script.  Did not run properly.")
     
    End Sub
    When I run it, it doesn't always delete everything. It seems to delete a couple and then stop working. If I take away the error trapping, there is an error trying to delete because 'the object has moved or doesn't delete'. It happens on this line:
    Code:
    If InStr(oApptItem.Subject, Range("A" & j).Value) > 0 Then
    When I hover over oApptItem.Subject, it says this item has moved or been removed.

    What is going on?

    Thanks!

  2. #2
    Board Regular Ragnar1211's Avatar
    Join Date
    Jul 2008
    Location
    Canada
    Posts
    571
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to delete Outlook Appointments

    The problem occurs because you are looping through the same outlook item, even though you have said to delete it, thus causing an error.

    Therefore you need to exit the "for j" loop if the if statement is true.

    Add Exit For after the oApptItem.Delete line and let me know if that fixes it.

    Gerry
    Real name: Gerry
    Occupation: Chartered Accountant
    Years using excel: Ever since my Dad brought home our first 512k Mac!

  3. #3
    Board Regular
    Join Date
    Apr 2009
    Posts
    104
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to delete Outlook Appointments

    Quote Originally Posted by Ragnar1211 View Post
    The problem occurs because you are looping through the same outlook item, even though you have said to delete it, thus causing an error.

    Therefore you need to exit the "for j" loop if the if statement is true.

    Add Exit For after the oApptItem.Delete line and let me know if that fixes it.

    Gerry
    Thank you -- so obvious and I forgot it would keep going through that j loop.

    But, for some reason, it still isn't deleting all of them. I know the subjects are the same because I'm adding them with another macro and reading the subject from the same cells. There are 14 total, one on each day (all day events). I add them all with a macro, and then I want to build this piece to delete them all. It deletes the first 5, but then doesn't delete the next 5. Then it deletes the next 3, and then stops deleting again.

    If I run a second time, it 'catches' different batch of them.

    I don't get an error anymore though after your update.

    P.S. I'm not sure if it would work, if it is easier, more efficient, etc., if I were to do it the other way. Loop through the cells and then try and find that appointment and delete it. But still not sure why this way doesn't work.
    Last edited by swayp11; Sep 15th, 2014 at 10:04 PM.

  4. #4
    Board Regular Ragnar1211's Avatar
    Join Date
    Jul 2008
    Location
    Canada
    Posts
    571
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to delete Outlook Appointments

    Try assigning the oApptItem.Subject to a variable before the j loop eg. crtsubject = oApptItem.Subject and then use the variable within the j loop.
    I have found controlling outlook to be a bit flaky, and you are asking it to read the exact same value from outlook over and over again every time in the j loop.

    I am not sure if that will solve the problem, but it might. I'll keep thinking on it
    Real name: Gerry
    Occupation: Chartered Accountant
    Years using excel: Ever since my Dad brought home our first 512k Mac!

  5. #5
    Board Regular
    Join Date
    Apr 2009
    Posts
    104
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to delete Outlook Appointments

    Hey Gerry,

    I tried assigning to the subject first but still the same spotty deleting.
    Code:
         Set oApptItem = oObject
         strSubject = oApptItem.Subject
         
         For j = 2 To Range("A1").End(xlDown).Row
            If strSubject = Range("A" & j).Value Then
        
    
    
                oApptItem.Delete
                Exit For
         
                
            End If
         Next j
    I did notice that it seems to always delete the same ones. I have 14 appointments that I added via macro. When trying to use the above code to delete them, it always deletes 1 through 5, then leaves 6 through 9, then deletes 10 through 12, then leaves 13 through 14. After 3 runs, it ends up deleting them all.

    Sometimes I've found that when VBA talks to other applications, the code runs 'too fast'. I'm wondering if it is just skipping over items?

    I tried another route, which is looping through the Excel sheet and searching for that appointment and deleting it:
    Code:
    For i = 2 To Range("A1").End(xlDown).Row
        strFind = "[Subject] ='" & Range("A" & i).Value & "'"
        
        Set oApptItem = oFolder.Items.Find(strFind)
        
        If Not TypeName(oApptItem) = "Nothing" Then
            oApptItem.Delete
        End If
        
        
    Next i
    This code works. But I'm still confused as to why the other method doesn't work.

  6. #6
    New Member
    Join Date
    Jan 2019
    Posts
    22
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to delete Outlook Appointments

    Hi Guys,

    I know this is a bit old but worth trying.

    I have the same issue, i have to run the macro a couple of times to delete all appointments matching criteria.

    I tried to slow down the macro but it didnt help.

    Any idea why this happened?

    Thanks,
    Masha

  7. #7
    Board Regular
    Join Date
    Oct 2007
    Posts
    5,751
    Post Thanks / Like
    Mentioned
    8 Post(s)
    Tagged
    2 Thread(s)

    Default Re: VBA to delete Outlook Appointments

    Loop backwards through the items by changing the For Each loop in the original code to:

    Code:
    Dim i As Long
    For i = oFolder.Items.Count To 1 Step -1
        If oFolder.Items(i).Class = olAppointment Then
            Set oApptItem = oFolder.Items(i)
            For j = 2 To Range("A1").End(xlDown).Row
                If InStr(oApptItem.Subject, Range("A" & j).Value) > 0 Then
                    oApptItem.Delete
                End If
            Next
        End If
    Next

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •