Solved

VBA code to delete specific calendar events

Posted on 2013-05-21
1
993 Views
Last Modified: 2013-05-24
I have the following lines of code that I am trying to use to remove specific calendar events prior to adding the updated events back using an sql server recordset.  When I run the code, it will delete some of the events, but I have to run it several times to delete all of the events. How can I change this code to delete ALL events in one code run that meet the subject criteria?

Dim myStart, myEnd As Date
    Dim oCalendar As Outlook.Folder
    Dim oItems As Outlook.Items
    Dim oResItems As Outlook.Items
    Dim oAppt As Outlook.AppointmentItem
    Dim strRestriction As String
  myStart = Date - 1
    myEnd = Date + 10
   

    Set oCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
    Set oItems = oCalendar.Items
      strRestriction = "[Start] <= '" & myEnd & "' AND [End] >= '" & myStart & "'"
      Set oResItems = oItems.Restrict(strRestriction)
    For Each oAppt In oResItems
     ' delete PTO entries
       If InStr(1, oAppt.Subject, "PTO:", vbTextCompare) > 0 Then
            oAppt.Delete
        End If

    Next
0
Comment
Question by:BradleyCleveland
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
1 Comment
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 39187036
Hi, BradleyCleveland.

There are two reasons the code would miss some appointments.  First, when deleting items you can't use a "FOR EACH" loop.  When you delete an item it changes the position of the items that appear after it.  This results in items being skipped.  Instead, you need to work backwards, starting at the end of the list and working toward its beginning.  To do this you use a "FOR x = COUNT OF ITEMS IN THE LIST TO 1 STEP -1".  Second, when dealing with appointments you have to consider recurring items.  To get the recurring items you need to sort the list by the start date and set IncludeRecurrences to True.  I've modified the code to do both.  Please give it a try and let me know if that does it for you.

Sub DeleteAppointments()
    Dim myStart, myEnd As Date
    Dim oCalendar As Outlook.Folder
    Dim oItems As Outlook.Items
    Dim oResItems As Outlook.Items
    Dim oAppt As Outlook.AppointmentItem
    Dim strRestriction As String
    Dim intCnt As Integer
    myStart = Date - 1
    myEnd = Date + 10
    Set oCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
    Set oItems = oCalendar.Items
    strRestriction = "[Start] <= '" & myEnd & "' AND [End] >= '" & myStart & "'"
    Set oResItems = oItems.Restrict(strRestriction)
    oResItems.Sort "[Start]"
    oResItems.IncludeRecurrences = True
    For intCnt = oResItems.Count To 1 Step -1
        Set oAppt = oResItems.Item(intCnt)
        ' delete PTO entries
        If InStr(1, oAppt.Subject, "PTO:", vbTextCompare) > 0 Then
            oAppt.Delete
        End If
    Next
End Sub

Open in new window

0

Featured Post

Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Large Outlook files lead to various unwanted errors and corruption issues. Furthermore, large outlook files can also make Outlook take longer to start-up, search, navigate, and shut-down. So, In this article, i will discuss a method to make your Out…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

733 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question