• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 544
  • Last Modified:

Deleting Outlook Appointment from Access

I have a form in Access that creates appointments in the Outlook calendar. As a part of the process it stores the GlobalAppointment ID and Entry ID with the record.

I was wondering if there was any code that could look an appointment from Access, and using the IDs, find the appointment and delete it?

The GlobalAppointment ID is stored in a field called GAID, and the Entry ID in EID
0
Greekiwi
Asked:
Greekiwi
  • 13
  • 9
1 Solution
 
TextReportCommented:
Hi with you using GlobalAppointmentID you must be using Outlook 2007, I found that though this was useful I could not search for it so had to use the EntryID for the search, I use the GetItemFromID method from the namespace.

Once you have found your appointment then you can use the delete method.

The example below uses a Public Type so I can declare a variable as aiAppointment and use this to pass to my standard function OutlookAppointment. This saves having to change the parameter when I need to add new functionality as I can just add it to the type.

Hope this helps

Andrew


Public Type aiAppointment
    dtmStart As Date
    booAllDayEvent As Boolean
    lngDuration As Long
    dtmRecurrenceEnds As Date
    lngReminderMinutesBeforeStart As Long
    'dtmEnd As Date
    strSubject As String
    strCategories As String
    strBody As String
    strLocation As String
    strEntryID As String
    strGlobalAppointmentID As String
    booDelete As Boolean
End Type
 
Function OutlookAppointment(appt As aiAppointment)
On Error GoTo AddAppt_Err
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
Dim outRecurrPatt As Outlook.RecurrencePattern
Dim outNameSpace As Outlook.NameSpace
Dim outFolder As Outlook.Folder
Dim strMSG As String
 
    Set outobj = CreateObject("outlook.application")
     
    If appt.strEntryID = "" Then
       Set outappt = outobj.CreateItem(olAppointmentItem)
    Else
       Set outNameSpace = outobj.GetNamespace("MAPI")
       Set outFolder = outNameSpace.GetDefaultFolder(olFolderCalendar)
 
       ' This is OK for EntryID but cant find the equivalant for GlobalAppointmentID
       Set outappt = outNameSpace.GetItemFromID(appt.strEntryID, outFolder.StoreID)
       'If outappt.GlobalAppointmentID <> Me.txtGlobalAppointmentID Then
       '   MsgBox "The GlobalAppointmentID does not match"
       'Else
    End If
       
    With outappt
         If appt.booDelete Then
            .Delete
         Else
            If appt.dtmRecurrenceEnds = 0 Then
               .Start = appt.dtmStart
               If appt.booAllDayEvent Then
                  .AllDayEvent = True
               Else
                  .AllDayEvent = False
                  .Duration = appt.lngDuration
                  '.End = appt.dtmEnd
               End If
            Else
               Set outRecurrPatt = .GetRecurrencePattern
               With outRecurrPatt
                   .RecurrenceType = olRecursDaily
                   .PatternStartDate = DateSerial(Year(appt.dtmStart), Month(appt.dtmStart), Day(appt.dtmStart))
                   .PatternEndDate = DateSerial(Year(appt.dtmRecurrenceEnds), Month(appt.dtmRecurrenceEnds), Day(appt.dtmRecurrenceEnds))
                   .StartTime = TimeSerial(Hour(appt.dtmStart), Minute(appt.dtmStart), Second(appt.dtmStart))
                   If appt.booAllDayEvent Then
                      .Duration = 1440
                   Else
                      .Duration = appt.lngDuration
                   End If
                   
               End With
            
            
            End If
            
            .Subject = appt.strSubject
            .Categories = appt.strCategories
            .Body = appt.strBody
            .Location = appt.strLocation
         
            If appt.lngReminderMinutesBeforeStart <= 0 Then
               .ReminderSet = False
            Else
               .ReminderSet = True
               .ReminderMinutesBeforeStart = appt.lngReminderMinutesBeforeStart
               .ReminderOverrideDefault = True
               .ReminderPlaySound = True
               .ReminderSoundFile = SysCmd(acSysCmdAccessDir) & "Reminder.wav"
            End If
         
            .Save
            If Val(.OutlookVersion) >= 12 And appt.strGlobalAppointmentID = "" Then appt.strGlobalAppointmentID = .GlobalAppointmentID
            If appt.strEntryID = "" Then appt.strEntryID = .EntryID
         End If
    End With
    
    ' Release the Outlook object variable.
    Set outobj = Nothing
     
AddAppt_Exit:
    Exit Function
 
AddAppt_Err:
    Select Case Err
        Case Else
             strMSG = "An unexpected error has oocurred in AddAppt" & vbCrLf & vbCrLf & _
                      "Error " & vbTab & "Description" & vbCrLf & _
                      Err.Number & vbTab & Err.Description
             Select Case MsgBox(strMSG, vbCritical + vbAbortRetryIgnore, "Error in AddAppt")
                 Case vbAbort:  Resume AddAppt_Exit
                 Case vbIgnore: Resume Next
                 Case vbRetry:  Resume
             End Select
    End Select
 
End Function

Open in new window

0
 
GreekiwiAuthor Commented:
That looks impressive. I am only looking for the delete method - but I don't know what that is.
0
 
TextReportCommented:
It's on line 43 .Delete and it is in the With so it is ineffect outappt.Delete.
Line 35 finds the appointment based on the EntryID
Cheers, Andrew
0
Get your Conversational Ransomware Defense e‑book

This e-book gives you an insight into the ransomware threat and reviews the fundamentals of top-notch ransomware preparedness and recovery. To help you protect yourself and your organization. The initial infection may be inevitable, so the best protection is to be fully prepared.

 
GreekiwiAuthor Commented:
This is what I have. I think I need to remove the IF somehow

Private Sub Command48_Click()
Set outappt = outNameSpace.GetItemFromID(Me!EID, outFolder.StoreID)
With outappt
         If appt.booDelete Then
            .Delete
End Sub
0
 
TextReportCommented:
Yes and you also need an End With
Cheers, Andrew
Private Sub Command48_Click()
 
    Set outappt = outNameSpace.GetItemFromID(Me!EID, outFolder.StoreID)
    With outappt
         .Delete
    End With
 
End Sub

Open in new window

0
 
GreekiwiAuthor Commented:
It says an object is required
0
 
TextReportCommented:
OK, you need to declare and set the variable.
Cheers, Andrew
Private Sub Command48_Click()
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
Dim outNameSpace As Outlook.NameSpace
Dim outFolder As Outlook.Folder
 
    Set outobj = CreateObject("outlook.application")
    Set outNameSpace = outobj.GetNamespace("MAPI")
    Set outFolder = outNameSpace.GetDefaultFolder(olFolderCalendar)
 
    Set outappt = outNameSpace.GetItemFromID(Me!EID, outFolder.StoreID)
    With outappt
         .Delete
    End With
 
    Set outFolder = Nothing
    Set outNameSpace = Nothing
    Set outobj = Nothing
 
End Sub

Open in new window

0
 
TextReportCommented:
You may find it easier to adopt the code I posted earlier by pasting it in a new module. In the module you should have an Option Compare and then add Option Explicit if it is not below the Option Compare commands then paste the code from earlier. You can then use the code below, much easier and you can also use it to add and update.

Cheers, Andrew
Private Sub Command48_Click()
Dim appt As aiAppointment
 
    With appt
        .strEntryID = Me!EID
        .booDelete = True
    End With
 
    OutlookAppointment appt
 
    MsgBox "Appointment Deleted"
 
End Sub

Open in new window

0
 
TextReportCommented:
Below is my test code that Create, Updates and Deletes an Appointment, paste it into the module with the Type and Function.
Cheers, Andrew
PS by using this approach if you need to modify the code to use a new version of Outlook or a different mail client you will only need to change the 1 function and not everywhere.
Sub TestAppointment()
Dim appt As aiAppointment
 
'Create a new appointment
    With appt
        .dtmStart = Now() + 1
'        .dtmRecurrenceEnds = .dtmStart + 28
        .booAllDayEvent = False
        .lngDuration = 30
        .lngReminderMinutesBeforeStart = 10
        .strLocation = "Home"
        .strSubject = "Test Subject"
    End With
    OutlookAppointment appt
    MsgBox "Appointment Created"
    
' Update the appointment
    With appt
        .strBody = Format(Now(), "dd mmmm yyyy hh:nn") & " Test Data Update"
    End With
    OutlookAppointment appt
    MsgBox "Appointment Updated"
    
' delete the appointment
    With appt
        .booDelete = True
    End With
    OutlookAppointment appt
    MsgBox "Appointment Deleted"
 
End Sub

Open in new window

0
 
GreekiwiAuthor Commented:
How does the code know when to add/update/delete if they are all bound to the same button?

Also with the first solution, is there anyway to clear the contents of the Me.EID field?
0
 
TextReportCommented:
Also with the first solution, is there anyway to clear the contents of the Me.EID field?

Me.EID = Null

My Code work as follows:-
If the appt variable doesn't have an strEntryID it has to be new and therefore creates the appointment. When it adds a new appointment the code sets the strEntryID and strGlobalAppointmentID that you can then store in your table.

If booDelete is false and there is an strEntryID then it is an update

If booDelete is True then there has to be an strEntryID and it will be deleted.

Cheers, Andrew
0
 
GreekiwiAuthor Commented:
Pardon my ignorance, but what is 'booDelete'?
0
 
TextReportCommented:
booDelete is part of the aiAppointment type that can be either TRUE or FALSE, it is FALSE by default but if you set it to true and then run OutlookAppointment it will delete the apointment for strEntryID

Cheers, Andrew
0
 
GreekiwiAuthor Commented:
How would one set it to true?
0
 
TextReportCommented:
It is done in the code examples in the posting http:#a23640040
Cheers, Andrew
0
 
GreekiwiAuthor Commented:
Looking at your original codes, I am not at all familiar with modules unfortunately :(

The system I have at the moment is:

Button 1: Adds an appointment (sets GAID and EID)
Button 2: Updates an appointment (searches for EID, then updates appt)
Button 3: Deletes an appointment (the accepted solution from here)
Button 4: Sets an appointment as "ON HOLD"  (creates a new appointment, or updates the body of an old one)

I could probably get rid of button 1, as the update button does have the ability to create a new appointment if no EID/GAID is set. I have attached the code for it below. What do you think?
Private Sub Command34_Click()
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
Dim outNameSpace As Outlook.NameSpace
Dim outFolder As Outlook.Folder
Dim strMSG As String
Dim cnt As Long
 
    ' Save record first to be sure required fields are filled.
    If Me.Dirty Then Me.Dirty = False
     
    Set outobj = CreateObject("outlook.application")
     
    If IsNull(Me!GAID) Then
       Set outappt = outobj.CreateItem(olAppointmentItem)
       With outappt
            .Start = Me!OrderDate & " " & Me!OrderStartTime
               .End = Me!OrderDate & " " & Me!OrderEndTime
               .Subject = Me!OrderName
               .Categories = OrderTruck
               If Not IsNull(Me!OrderNotes) Then .Body = Me!OrderNotes
               If Not IsNull(Me!OrderPickUp) Then .Location = _
                  Me!OrderPickUp
            .Save
            Me!GAID = .GlobalAppointmentID
            Me!EID = .EntryID
       End With
    Else
        Set outNameSpace = outobj.GetNamespace("MAPI")
        Set outFolder = outNameSpace.GetDefaultFolder(olFolderCalendar)
 
' This is OK for EntryID but cant find the equivalant for GlobalAppointmentID
        Set outappt = outNameSpace.GetItemFromID(Me!EID, outFolder.StoreID)
        If outappt.GlobalAppointmentID <> Me!GAID Then
           MsgBox "The GlobalAppointmentID does not match"
        Else
           With outappt
               .Start = Me!OrderDate & " " & Me!OrderStartTime
               .End = Me!OrderDate & " " & Me!OrderEndTime
               .Subject = Me!OrderName
               .Categories = OrderTruck
               If Not IsNull(Me!OrderNotes) Then .Body = Me!OrderNotes
               If Not IsNull(Me!OrderPickUp) Then .Location = _
                  Me!OrderPickUp
            .Save
            Me.OrderHold = False
           End With
        End If
    End If
    
    ' Release the Outlook object variable.
    Set outobj = Nothing
     
    If Me.Dirty Then Me.Dirty = False
    MsgBox "Appointment Added / Updated"
    
AddAppt_Exit:
    Exit Sub
 
AddAppt_Err:
    Select Case Err
        Case Else
             strMSG = "An unexpected error has oocurred in AddAppt" & vbCrLf & vbCrLf & _
                      "Error " & vbTab & "Description" & vbCrLf & _
                      Err.Number & vbTab & Err.Description
             Select Case MsgBox(strMSG, vbCritical + vbAbortRetryIgnore, "Error in AddAppt")
                 Case vbAbort:  Resume AddAppt_Exit
                 Case vbIgnore: Resume Next
                 Case vbRetry:  Resume
             End Select
    End Select
End Sub

Open in new window

0
 
TextReportCommented:
In Access 2007 you need to go to the Create menu option then select the Macro Drop Down and select Module. This will create a standard module that you need to paste the code I pasted in http:#a23639811 and http:#a23640048. Doing this means that the Type and Routine will be available to all your modules.

Then you can use the code from http:#a23640040 for your DELETE button and the code below for your Add/Update button

Cheers, Andrew
Private Sub Command34_Click()
Dim appt As aiAppointment
 
    With appt
        .dtmStart = Me!OrderDate & " " & Me!OrderStartTime
        .dtmEnd = Me!OrderDate & " " & Me!OrderEndTime
        .strSubject = Me!OrderName
        .strCategories = OrderTruck
        If Not IsNull(Me!OrderNotes) Then .strBody = Me!OrderNotes
        If Not IsNull(Me!OrderPickUp) Then .strLocation =  Me!OrderPickUp
        If Not IsNull(Me!EID) Then .strEntryID =  Me!EID
        If Not IsNull(Me!GAID) Then .strGlobalAppointmentID =  Me!GAID
    End With
 
    OutlookAppointment appt
 
' This saves the ID's if they are not already set (New Appointments)
    If IsNull(Me!EID) Then Me!EID = appt.strEntryID
    If IsNull(Me!GAID) Then Me!GAID = appt.strGlobalAppointmentID
 
    MsgBox "Appointment Created / Updated"
 
End Sub

Open in new window

0
 
GreekiwiAuthor Commented:
I've got a q about your module. I am looking to add some greater versatility to my database. Instead of adding all the appointments to the default calendar, I wish to add them to different calendars, depending on which Truck (OrderTruck) they belong to.

Would this be easily achieved with your module? Or would it be just as simple/complicated on my version?

I will of course open a new question for more points if it is possible/ you were willing to help
0
 
TextReportCommented:
Theoretically changing my code should be simple but I haven't tried it. I do not have Exchange Server to test it with as I think the code at http://www.outlookcode.com/codedetail.aspx?id=43 needs Exchange.

I am looking into it formy own use with Outlook 2007 with multiple PST files but I have not got it working yet.

Cheers, Andrew
0
 
TextReportCommented:
The other thing you can do in 2007 much better than in previous versions is attaching to the calendar as if it were a linked table. You can then insert records as if it were in an access table.

Cheers, Andrew
0
 
GreekiwiAuthor Commented:
What if all the calendars were on the same computer. This database is made to work with one computer. The reason I want multiple calendars is that this is for a moving company that has three trucks. I want each truck to have its own calendar. This will make it easier to differentiate which bookings are on which trucks.

Is that do-able?
0
 
TextReportCommented:
You can use Folders as in the example I linked to earlier (I think), these can be created manually in Outlook 2007 and then select for the appointment.

Cheers, Andrew
0
 
MetzgertrainerCommented:
Here is the code I have uswed to assigne the appointments to a different calander than the default.

This was added to Andrews amazing code on line following the variable declarations in the Function.
"blarg" is the name of the test calendar that I created.  This is directly under that default calander.

I hope this helps : )

-- Michelle
    Set outobj = CreateObject("outlook.application")
    Set outNameSpace = outobj.GetNamespace("MAPI")
    Set outFolder = outNameSpace.GetDefaultFolder(olFolderCalendar).Folders("blarg")

Open in new window

0

Featured Post

Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

  • 13
  • 9
Tackle projects and never again get stuck behind a technical roadblock.
Join Now