Deleting an outlook calendar entry via Access 2007

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I have a portion of an Access app that creates an Outlook Calendar item.
That part works fine. The problem is, I have nother part of the same Access
app that has need to delete the calendar item if it gets cancelled. I
haven't been able to figure out how to use automation within Access to locate
the item, and then delete it.

Any ideas would be very much appreciated. And yes it has to be done this
way for now, I can't just use Outlook to do it, or believe me I would. It
would be much easier.

Thanks,

Keith Fear
 
Hi Keith

Have you considered using the 'Microsoft Office Outlook View Control'
ActiveX control - get it from 'More Controls' on the Access Tools toolbar.
This provides a window through to the Outlook Calender items from where you
can Delete any item.

Cheers.

BW
 
To BW: I've not seen the Microsoft Office Outlook View Control before.
How do you get it to display the Calendar? I could only get it to display
the Inbox

To Keith: You asked for help with automation. As you don't say what
information you store in Access to keep track of Calendar items, I give
three demonstrations below, which you can copy and paste into an Access
module and modify to suit you best:

Demo 1 - How to delete an Appointment Item if you know its subject.

Demo 2 - How to delete an Appointment Item if you know its start date/time.

Demo 3 - How to permanently delete an Appointment Item if you know its start
date/time.

Demos 1 and 2 will move the deleted item to the Deleted Items folder.
Demo 3 won't.

You will have to modify these demos so as to uniquely identify the
Appointment Item you want to delete. For example, you could check the
appointment's start date/time *and* its subject heading. You could
additionally test for any other properties you have values for before you
invoke the delete method.

I recommend you backup your Outlook data file *before* running a program
that automatically deletes anything. Then get the program to delete one item
to begin with and verify the program works as you expect.

Outlook stores its data in files with the filename extension *.pst. These
used to be known as personal store files. You can open the File menu and
select Data File Management to find out where these files are on your hard
disc.

Geoff


Option Compare Database
Option Explicit

'------------------------------------------------------
' This Access module needs references to:
'
' Microsoft Outlook [VersionNo] Object Library
' Microsoft CDO 1.21 Library
'
' To set references, in the VBA Editor, open the
' Tools menu and select References.
'------------------------------------------------------


' OUTLOOK OBJECT VARIABLES:

Private mobjOLA As Outlook.Application
Private mobjNS As Outlook.NameSpace
Private mobjFLDR As Outlook.MAPIFolder
Private mobjAPPT As Outlook.AppointmentItem

' CDO (COLLABORATION DATA OBJECTS) VARIABLES:

Private mobjCDOSession As MAPI.Session
Private mobjMAPIAppt As MAPI.Message



Private Sub ExampleCall_DeleteBySubject()

' Read note below!

Dim strSubject As String

' Delete an appointment with the subject heading
' "My Test Appointment":
strSubject = "My Test Appointment"
Call DeleteAppointmentItemBySubject(strSubject)

End Sub

Private Sub DeleteAppointmentItemBySubject(strSubject As String)

' Use this method ONLY if the subject of the
' Appointment Item is known and is UNIQUE.

Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

On Error Resume Next
Set mobjAPPT = mobjFLDR.Items(strSubject)
If Err.Number <> 0 Then GoTo CannotFindObject
mobjAPPT.Delete

Bye:

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

Exit Sub

CannotFindObject:

MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly, "Information"
GoTo Bye

End Sub


Private Sub ExampleCall_NotPermanentDelete()

' Read note below!

Dim datApptStart As Date
Dim datDate As Date
Dim datTime As Date

' Delete (not permanently) an appointment that
' starts on March 1, 2007, at 9 am:
datDate = DateSerial(2007, 3, 1)
datTime = TimeSerial(9, 0, 0)
datApptStart = datDate + datTime
Call DeleteToDeletedFolder(datApptStart)

End Sub

Private Sub DeleteToDeletedFolder(datStart As Date)

' Use this subprocedure if you have the start date and time
' of the Appointment you want to delete.

' This subprocedure can be modified to test for any known
' property or properties of the appointment item. As more
' than one appointment could start at the same time, it
' would be necessary to examine another property to
' determine which one should be deleted. Modify the "If"
' statement accordingly.

' This subprocedure will place the deleted item in the
' Deleted Items folder.

' This subprocedure may be unsuitable if there are a
' large number of items in the Calendar folder (see
' using CDO below).

Dim fItemDeleted As Boolean

fItemDeleted = False
Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

For Each mobjAPPT In mobjFLDR.Items
If mobjAPPT.Start = datStart Then
mobjAPPT.Delete
fItemDeleted = True
Exit For
End If
Next

If fItemDeleted = False Then
MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly + vbExclamation, "Information"
End If

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

End Sub


Private Sub ExampleCall_DeletePermanently()

' Read note below!

Dim datApptStart As Date
Dim datDate As Date
Dim datTime As Date

' Delete (permanently) an appointment that
' starts on March 1, 2007, at 10:30 am:
datDate = DateSerial(2007, 3, 1)
datTime = TimeSerial(10, 30, 0)
datApptStart = datDate + datTime
Call PermanentlyDeleteAppointment(datApptStart)

End Sub

Private Sub PermanentlyDeleteAppointment(datStart As Date)

' This subprocedure needs a reference to the
' Microsoft CDO 1.21 Library.

' CDO is much faster and more reliable if looping
' through a large collection of items.

' This subprocedure will delete an appointment
' item and will *NOT* place it in the Deleted Items
' folder.

' This subprocedure can be modified to test for any known
' property or properties of the appointment item. As more
' than one appointment could start at the same time, it
' would be necessary to examine another property to
' determine which one should be deleted. Modify the "If"
' statement accordingly.

Dim fItemFound As Boolean
Dim strEntryID As String
Dim strStoreID As String

fItemFound = False
Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

' Loop through Calendar folder until the item with
' the incoming datStart is found:
For Each mobjAPPT In mobjFLDR.Items
If mobjAPPT.Start = datStart Then
fItemFound = True
Exit For
End If
Next

If fItemFound Then
GoTo DeleteAppointmentItemUsingCDO
Else
GoTo AppointmentItemNotFound
End If

Bye:

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

Exit Sub

DeleteAppointmentItemUsingCDO:

' Get EntryID from Outlook Appointment item:
strEntryID = mobjAPPT.EntryID

' Get Folder's storeID:
strStoreID = mobjFLDR.StoreID

' Logon to CDO:
Call DoCDOLogon

' Point MAPI object to Appointment Item:
Set mobjMAPIAppt = mobjCDOSession.GetMessage(strEntryID, _
strStoreID)

' Delete MAPI object:
mobjMAPIAppt.Delete

' Logoff from CDO (see note under DoCDOLogon):
Call DoCDOLogoff

GoTo Bye

AppointmentItemNotFound:

MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly + vbExclamation, "Information"

GoTo Bye

End Sub

Private Sub DoCDOLogon()

' If deleting many items, do not logon and logoff
' repeatedly to CDO in quick succession. Instead,
' modify the code to logon once at the beginning
' of a delete session and logoff at the end of
' the session.

If mobjCDOSession Is Nothing Then
Set mobjCDOSession = CreateObject("MAPI.Session")
mobjCDOSession.Logon , , False, False
End If

End Sub

Private Sub DoCDOLogoff()

' See note under DoCDOLogon.

If mobjCDOSession Is Nothing Then Exit Sub
mobjCDOSession.Logoff
Set mobjCDOSession = Nothing

End Sub
 
This worked perfectly. Thank you very much! Now I am going to work with it
and modify it to check date and subject and delete if they both match. This
does exactly what I need.

Thanks,

Keith FEar

GeoffG said:
To BW: I've not seen the Microsoft Office Outlook View Control before.
How do you get it to display the Calendar? I could only get it to display
the Inbox

To Keith: You asked for help with automation. As you don't say what
information you store in Access to keep track of Calendar items, I give
three demonstrations below, which you can copy and paste into an Access
module and modify to suit you best:

Demo 1 - How to delete an Appointment Item if you know its subject.

Demo 2 - How to delete an Appointment Item if you know its start date/time.

Demo 3 - How to permanently delete an Appointment Item if you know its start
date/time.

Demos 1 and 2 will move the deleted item to the Deleted Items folder.
Demo 3 won't.

You will have to modify these demos so as to uniquely identify the
Appointment Item you want to delete. For example, you could check the
appointment's start date/time *and* its subject heading. You could
additionally test for any other properties you have values for before you
invoke the delete method.

I recommend you backup your Outlook data file *before* running a program
that automatically deletes anything. Then get the program to delete one item
to begin with and verify the program works as you expect.

Outlook stores its data in files with the filename extension *.pst. These
used to be known as personal store files. You can open the File menu and
select Data File Management to find out where these files are on your hard
disc.

Geoff


Option Compare Database
Option Explicit

'------------------------------------------------------
' This Access module needs references to:
'
' Microsoft Outlook [VersionNo] Object Library
' Microsoft CDO 1.21 Library
'
' To set references, in the VBA Editor, open the
' Tools menu and select References.
'------------------------------------------------------


' OUTLOOK OBJECT VARIABLES:

Private mobjOLA As Outlook.Application
Private mobjNS As Outlook.NameSpace
Private mobjFLDR As Outlook.MAPIFolder
Private mobjAPPT As Outlook.AppointmentItem

' CDO (COLLABORATION DATA OBJECTS) VARIABLES:

Private mobjCDOSession As MAPI.Session
Private mobjMAPIAppt As MAPI.Message



Private Sub ExampleCall_DeleteBySubject()

' Read note below!

Dim strSubject As String

' Delete an appointment with the subject heading
' "My Test Appointment":
strSubject = "My Test Appointment"
Call DeleteAppointmentItemBySubject(strSubject)

End Sub

Private Sub DeleteAppointmentItemBySubject(strSubject As String)

' Use this method ONLY if the subject of the
' Appointment Item is known and is UNIQUE.

Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

On Error Resume Next
Set mobjAPPT = mobjFLDR.Items(strSubject)
If Err.Number <> 0 Then GoTo CannotFindObject
mobjAPPT.Delete

Bye:

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

Exit Sub

CannotFindObject:

MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly, "Information"
GoTo Bye

End Sub


Private Sub ExampleCall_NotPermanentDelete()

' Read note below!

Dim datApptStart As Date
Dim datDate As Date
Dim datTime As Date

' Delete (not permanently) an appointment that
' starts on March 1, 2007, at 9 am:
datDate = DateSerial(2007, 3, 1)
datTime = TimeSerial(9, 0, 0)
datApptStart = datDate + datTime
Call DeleteToDeletedFolder(datApptStart)

End Sub

Private Sub DeleteToDeletedFolder(datStart As Date)

' Use this subprocedure if you have the start date and time
' of the Appointment you want to delete.

' This subprocedure can be modified to test for any known
' property or properties of the appointment item. As more
' than one appointment could start at the same time, it
' would be necessary to examine another property to
' determine which one should be deleted. Modify the "If"
' statement accordingly.

' This subprocedure will place the deleted item in the
' Deleted Items folder.

' This subprocedure may be unsuitable if there are a
' large number of items in the Calendar folder (see
' using CDO below).

Dim fItemDeleted As Boolean

fItemDeleted = False
Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

For Each mobjAPPT In mobjFLDR.Items
If mobjAPPT.Start = datStart Then
mobjAPPT.Delete
fItemDeleted = True
Exit For
End If
Next

If fItemDeleted = False Then
MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly + vbExclamation, "Information"
End If

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

End Sub


Private Sub ExampleCall_DeletePermanently()

' Read note below!

Dim datApptStart As Date
Dim datDate As Date
Dim datTime As Date

' Delete (permanently) an appointment that
' starts on March 1, 2007, at 10:30 am:
datDate = DateSerial(2007, 3, 1)
datTime = TimeSerial(10, 30, 0)
datApptStart = datDate + datTime
Call PermanentlyDeleteAppointment(datApptStart)

End Sub

Private Sub PermanentlyDeleteAppointment(datStart As Date)

' This subprocedure needs a reference to the
' Microsoft CDO 1.21 Library.

' CDO is much faster and more reliable if looping
' through a large collection of items.

' This subprocedure will delete an appointment
' item and will *NOT* place it in the Deleted Items
' folder.

' This subprocedure can be modified to test for any known
' property or properties of the appointment item. As more
' than one appointment could start at the same time, it
' would be necessary to examine another property to
' determine which one should be deleted. Modify the "If"
' statement accordingly.

Dim fItemFound As Boolean
Dim strEntryID As String
Dim strStoreID As String

fItemFound = False
Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

' Loop through Calendar folder until the item with
' the incoming datStart is found:
For Each mobjAPPT In mobjFLDR.Items
If mobjAPPT.Start = datStart Then
fItemFound = True
Exit For
End If
Next

If fItemFound Then
GoTo DeleteAppointmentItemUsingCDO
Else
GoTo AppointmentItemNotFound
End If

Bye:

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

Exit Sub

DeleteAppointmentItemUsingCDO:

' Get EntryID from Outlook Appointment item:
strEntryID = mobjAPPT.EntryID

' Get Folder's storeID:
strStoreID = mobjFLDR.StoreID

' Logon to CDO:
Call DoCDOLogon

' Point MAPI object to Appointment Item:
Set mobjMAPIAppt = mobjCDOSession.GetMessage(strEntryID, _
strStoreID)

' Delete MAPI object:
mobjMAPIAppt.Delete

' Logoff from CDO (see note under DoCDOLogon):
Call DoCDOLogoff

GoTo Bye

AppointmentItemNotFound:

MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly + vbExclamation, "Information"

GoTo Bye

End Sub

Private Sub DoCDOLogon()

' If deleting many items, do not logon and logoff
' repeatedly to CDO in quick succession. Instead,
' modify the code to logon once at the beginning
' of a delete session and logoff at the end of
' the session.

If mobjCDOSession Is Nothing Then
Set mobjCDOSession = CreateObject("MAPI.Session")
mobjCDOSession.Logon , , False, False
End If

End Sub

Private Sub DoCDOLogoff()

' See note under DoCDOLogon.

If mobjCDOSession Is Nothing Then Exit Sub
mobjCDOSession.Logoff
Set mobjCDOSession = Nothing
Click to expand...
 
This worked perfectly. Thank you very much! Now I am going to work
with it and modify it to check date and subject and delete if they both
match. This does exactly what I need.
Click to expand...

Glad you're on your way! You may be interested in the following good book on
Outlook Programming:

"Microsoft Outlook Programming - Jumpstart for Administrators, Developers
and Power Users" by Sue Mosher.

See also:
http://www.outlookcode.com/

Amongst many other things, the book and the website explain the use of the
Redemption Object Library. This is the method you can use in your VBA
programs to avoid the Microsoft Security Guard - which displays a prompt to
the user when a program attempts to access Outlook address data, etc.
Sometimes, you don't want prompts appearing.

Good luck with your Automation programming.
Geoff
 
In a previous post, I mentioned it was faster and more reliable to use CDO
to loop through a large collection. However, it's struck me I haven't given
you a relevant example. Demo 4 (below) loops through Outlook's Calendar
folder using a CDO folder object variable. (Demos 2 and 3 used an Outlook
Folder object variable.) Also, Demo 4 deletes an Appointment item by
examining its start date/time and subject.

Geoff.


Two new variables for the general declarations section:

' CDO (COLLABORATION DATA OBJECTS) VARIABLES:

Private mobjCDOSession As MAPI.Session
Private mobjMAPIAppt As MAPI.Message
Private mobjMAPIFldr As MAPI.Folder
Private mobjMAPIApptItem As MAPI.AppointmentItem


Private Sub ExampleCall_DeletePermanentlyAppointmentDemo4()

Dim datStart As Date
Dim datDate As Date
Dim datTime As Date
Dim strSubject As String

datDate = DateSerial(2007, 3, 2)
datTime = TimeSerial(11, 15, 0)
datStart = datDate + datTime
strSubject = "My Test Appointment"

Call PermanentlyDeleteAppointmentDemo4(datStart, strSubject)

End Sub

Private Sub PermanentlyDeleteAppointmentDemo4( _
datStart As Date, _
strSubject As String)

' DEMO 4.

' This subprocedure will delete an appointment Item
' based on its start date/time and subject and
' will *NOT* place it in the Deleted Items folder.

' This subprocedure needs a reference to the
' Microsoft CDO 1.21 Library. CDO object variables
' can be declared with the prefix "MAPI." to make
' them unambiguous.

' This subprocedure gets Outlook's Calendar folder as
' a MAPI.Folder object (ie uses the CDO object model).
' (Contrast this with Demos 2 and 3, which used an
' Outlook.MAPIFolder object, ie used the Outlook
' object model).

' This subprocedure then loops through the
' MAPI.Folder's Messages collection. The variable
' mobjMAPIApptItem is used to point to each Message in turn.
' The variable, mobjMAPIApptItem, is declared as a
' MAPI.AppointmentItem (not a MAPI.Message). Nevertheless,
' the loop works, seemingly because the MAPI.AppointmentItem
' object is a SubClass of the MAPI.Message object and
' because we're looping through the Calendar folder, which
' contains AppointmentItems. (See the file CDO.HLP for more
' information.) The MAPI.AppointmentItem object has a
' StartTime property (for when the Appointment is due to
' start), whereas the MAPI.Message object doesn't have this
' property.

Dim fItemFound As Boolean

fItemFound = False
Call DoCDOLogon
Set mobjMAPIFldr = mobjCDOSession.GetDefaultFolder( _
CdoDefaultFolderCalendar)

For Each mobjMAPIApptItem In mobjMAPIFldr.Messages
If mobjMAPIApptItem.StartTime = datStart _
And mobjMAPIApptItem.Subject = strSubject Then
fItemFound = True
mobjMAPIApptItem.Delete
Exit For
End If
Next

If fItemFound = False Then
GoTo AppointmentItemNotFound
End If

Call DoCDOLogoff

Bye:

Set mobjMAPIApptItem = Nothing
Exit Sub

AppointmentItemNotFound:

MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly + vbExclamation, "Information"

GoTo Bye

End Sub
 
Geoff,
Thank you so much for the codes below. I've been trying to do this for a
while, and haven't been able to get it to work. You're a life saver...

Thank you, thank you!!!!

GeoffG said:
To BW: I've not seen the Microsoft Office Outlook View Control before.
How do you get it to display the Calendar? I could only get it to display
the Inbox

To Keith: You asked for help with automation. As you don't say what
information you store in Access to keep track of Calendar items, I give
three demonstrations below, which you can copy and paste into an Access
module and modify to suit you best:

Demo 1 - How to delete an Appointment Item if you know its subject.

Demo 2 - How to delete an Appointment Item if you know its start date/time.

Demo 3 - How to permanently delete an Appointment Item if you know its start
date/time.

Demos 1 and 2 will move the deleted item to the Deleted Items folder.
Demo 3 won't.

You will have to modify these demos so as to uniquely identify the
Appointment Item you want to delete. For example, you could check the
appointment's start date/time *and* its subject heading. You could
additionally test for any other properties you have values for before you
invoke the delete method.

I recommend you backup your Outlook data file *before* running a program
that automatically deletes anything. Then get the program to delete one item
to begin with and verify the program works as you expect.

Outlook stores its data in files with the filename extension *.pst. These
used to be known as personal store files. You can open the File menu and
select Data File Management to find out where these files are on your hard
disc.

Geoff


Option Compare Database
Option Explicit

'------------------------------------------------------
' This Access module needs references to:
'
' Microsoft Outlook [VersionNo] Object Library
' Microsoft CDO 1.21 Library
'
' To set references, in the VBA Editor, open the
' Tools menu and select References.
'------------------------------------------------------


' OUTLOOK OBJECT VARIABLES:

Private mobjOLA As Outlook.Application
Private mobjNS As Outlook.NameSpace
Private mobjFLDR As Outlook.MAPIFolder
Private mobjAPPT As Outlook.AppointmentItem

' CDO (COLLABORATION DATA OBJECTS) VARIABLES:

Private mobjCDOSession As MAPI.Session
Private mobjMAPIAppt As MAPI.Message



Private Sub ExampleCall_DeleteBySubject()

' Read note below!

Dim strSubject As String

' Delete an appointment with the subject heading
' "My Test Appointment":
strSubject = "My Test Appointment"
Call DeleteAppointmentItemBySubject(strSubject)

End Sub

Private Sub DeleteAppointmentItemBySubject(strSubject As String)

' Use this method ONLY if the subject of the
' Appointment Item is known and is UNIQUE.

Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

On Error Resume Next
Set mobjAPPT = mobjFLDR.Items(strSubject)
If Err.Number <> 0 Then GoTo CannotFindObject
mobjAPPT.Delete

Bye:

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

Exit Sub

CannotFindObject:

MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly, "Information"
GoTo Bye

End Sub


Private Sub ExampleCall_NotPermanentDelete()

' Read note below!

Dim datApptStart As Date
Dim datDate As Date
Dim datTime As Date

' Delete (not permanently) an appointment that
' starts on March 1, 2007, at 9 am:
datDate = DateSerial(2007, 3, 1)
datTime = TimeSerial(9, 0, 0)
datApptStart = datDate + datTime
Call DeleteToDeletedFolder(datApptStart)

End Sub

Private Sub DeleteToDeletedFolder(datStart As Date)

' Use this subprocedure if you have the start date and time
' of the Appointment you want to delete.

' This subprocedure can be modified to test for any known
' property or properties of the appointment item. As more
' than one appointment could start at the same time, it
' would be necessary to examine another property to
' determine which one should be deleted. Modify the "If"
' statement accordingly.

' This subprocedure will place the deleted item in the
' Deleted Items folder.

' This subprocedure may be unsuitable if there are a
' large number of items in the Calendar folder (see
' using CDO below).

Dim fItemDeleted As Boolean

fItemDeleted = False
Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

For Each mobjAPPT In mobjFLDR.Items
If mobjAPPT.Start = datStart Then
mobjAPPT.Delete
fItemDeleted = True
Exit For
End If
Next

If fItemDeleted = False Then
MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly + vbExclamation, "Information"
End If

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

End Sub


Private Sub ExampleCall_DeletePermanently()

' Read note below!

Dim datApptStart As Date
Dim datDate As Date
Dim datTime As Date

' Delete (permanently) an appointment that
' starts on March 1, 2007, at 10:30 am:
datDate = DateSerial(2007, 3, 1)
datTime = TimeSerial(10, 30, 0)
datApptStart = datDate + datTime
Call PermanentlyDeleteAppointment(datApptStart)

End Sub

Private Sub PermanentlyDeleteAppointment(datStart As Date)

' This subprocedure needs a reference to the
' Microsoft CDO 1.21 Library.

' CDO is much faster and more reliable if looping
' through a large collection of items.

' This subprocedure will delete an appointment
' item and will *NOT* place it in the Deleted Items
' folder.

' This subprocedure can be modified to test for any known
' property or properties of the appointment item. As more
' than one appointment could start at the same time, it
' would be necessary to examine another property to
' determine which one should be deleted. Modify the "If"
' statement accordingly.

Dim fItemFound As Boolean
Dim strEntryID As String
Dim strStoreID As String

fItemFound = False
Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

' Loop through Calendar folder until the item with
' the incoming datStart is found:
For Each mobjAPPT In mobjFLDR.Items
If mobjAPPT.Start = datStart Then
fItemFound = True
Exit For
End If
Next

If fItemFound Then
GoTo DeleteAppointmentItemUsingCDO
Else
GoTo AppointmentItemNotFound
End If

Bye:

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

Exit Sub

DeleteAppointmentItemUsingCDO:

' Get EntryID from Outlook Appointment item:
strEntryID = mobjAPPT.EntryID

' Get Folder's storeID:
strStoreID = mobjFLDR.StoreID

' Logon to CDO:
Call DoCDOLogon

' Point MAPI object to Appointment Item:
Set mobjMAPIAppt = mobjCDOSession.GetMessage(strEntryID, _
strStoreID)

' Delete MAPI object:
mobjMAPIAppt.Delete

' Logoff from CDO (see note under DoCDOLogon):
Call DoCDOLogoff

GoTo Bye

AppointmentItemNotFound:

MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly + vbExclamation, "Information"

GoTo Bye

End Sub

Private Sub DoCDOLogon()

' If deleting many items, do not logon and logoff
' repeatedly to CDO in quick succession. Instead,
' modify the code to logon once at the beginning
' of a delete session and logoff at the end of
' the session.

If mobjCDOSession Is Nothing Then
Set mobjCDOSession = CreateObject("MAPI.Session")
mobjCDOSession.Logon , , False, False
End If

End Sub

Private Sub DoCDOLogoff()

' See note under DoCDOLogon.

If mobjCDOSession Is Nothing Then Exit Sub
mobjCDOSession.Logoff
Set mobjCDOSession = Nothing
Click to expand...
 
Great!

One thing I noticed after posting was that, if you use Collaboration Data
Objects (CDO) to permanently delete an item, Outlook, alas, does not update
its Date-Navigation pane. (This pane is the small Outlook window where dates
get emboldened when they have an appointment set.) In other words, you may
permanently delete the last Appointment item on any given date using CDO,
but the relevant date will still be emboldened in the Date-Navigation Pane.

I think the text book that recommended the CDO approach did so on the basis
that, if you don't use CDO, then the deleted item goes into the Deleted
Items folder and you then have to delete it again from there. There seemed
to be a suggestion that this is tedious, hence the idea of using CDO to
delete an item in one fell swoop.

However, I've discovered (since posting) that it is extremely easy to make
the deletion from the Deleted Items folder - in fact I think it's probably
easier than using CDO. You simply need to store the StoreID and EntryID
(which are both very long strings) of the item you're deleting before you
delete it. Then, after deleting the item, you can delete it from the Deleted
Items folder in one line of code simply by using the StoreID and EntryID -
ie *without* referencing the Deleted-Items folder. This works because every
item in each store has a unique EntryID, regardless of what type of item it
is. By using this method (ie not using CDO), the Date-Navigation Pane does
get updated. If this is of interest to you and you can't figure what I mean,
post back and I'll look up the code example.

Regards
Geoff


dbornt said:
Geoff,
Thank you so much for the codes below. I've been trying to do this for
a
while, and haven't been able to get it to work. You're a life saver...

Thank you, thank you!!!!

GeoffG said:
To BW: I've not seen the Microsoft Office Outlook View Control before.
How do you get it to display the Calendar? I could only get it to display
the Inbox

To Keith: You asked for help with automation. As you don't say what
information you store in Access to keep track of Calendar items, I give
three demonstrations below, which you can copy and paste into an Access
module and modify to suit you best:

Demo 1 - How to delete an Appointment Item if you know its subject.

Demo 2 - How to delete an Appointment Item if you know its start
date/time.

Demo 3 - How to permanently delete an Appointment Item if you know its
start
date/time.

Demos 1 and 2 will move the deleted item to the Deleted Items folder.
Demo 3 won't.

You will have to modify these demos so as to uniquely identify the
Appointment Item you want to delete. For example, you could check the
appointment's start date/time *and* its subject heading. You could
additionally test for any other properties you have values for before you
invoke the delete method.

I recommend you backup your Outlook data file *before* running a program
that automatically deletes anything. Then get the program to delete one
item
to begin with and verify the program works as you expect.

Outlook stores its data in files with the filename extension *.pst. These
used to be known as personal store files. You can open the File menu and
select Data File Management to find out where these files are on your
hard
disc.

Geoff


Option Compare Database
Option Explicit

'------------------------------------------------------
' This Access module needs references to:
'
' Microsoft Outlook [VersionNo] Object Library
' Microsoft CDO 1.21 Library
'
' To set references, in the VBA Editor, open the
' Tools menu and select References.
'------------------------------------------------------


' OUTLOOK OBJECT VARIABLES:

Private mobjOLA As Outlook.Application
Private mobjNS As Outlook.NameSpace
Private mobjFLDR As Outlook.MAPIFolder
Private mobjAPPT As Outlook.AppointmentItem

' CDO (COLLABORATION DATA OBJECTS) VARIABLES:

Private mobjCDOSession As MAPI.Session
Private mobjMAPIAppt As MAPI.Message



Private Sub ExampleCall_DeleteBySubject()

' Read note below!

Dim strSubject As String

' Delete an appointment with the subject heading
' "My Test Appointment":
strSubject = "My Test Appointment"
Call DeleteAppointmentItemBySubject(strSubject)

End Sub

Private Sub DeleteAppointmentItemBySubject(strSubject As String)

' Use this method ONLY if the subject of the
' Appointment Item is known and is UNIQUE.

Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

On Error Resume Next
Set mobjAPPT = mobjFLDR.Items(strSubject)
If Err.Number <> 0 Then GoTo CannotFindObject
mobjAPPT.Delete

Bye:

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

Exit Sub

CannotFindObject:

MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly, "Information"
GoTo Bye

End Sub


Private Sub ExampleCall_NotPermanentDelete()

' Read note below!

Dim datApptStart As Date
Dim datDate As Date
Dim datTime As Date

' Delete (not permanently) an appointment that
' starts on March 1, 2007, at 9 am:
datDate = DateSerial(2007, 3, 1)
datTime = TimeSerial(9, 0, 0)
datApptStart = datDate + datTime
Call DeleteToDeletedFolder(datApptStart)

End Sub

Private Sub DeleteToDeletedFolder(datStart As Date)

' Use this subprocedure if you have the start date and time
' of the Appointment you want to delete.

' This subprocedure can be modified to test for any known
' property or properties of the appointment item. As more
' than one appointment could start at the same time, it
' would be necessary to examine another property to
' determine which one should be deleted. Modify the "If"
' statement accordingly.

' This subprocedure will place the deleted item in the
' Deleted Items folder.

' This subprocedure may be unsuitable if there are a
' large number of items in the Calendar folder (see
' using CDO below).

Dim fItemDeleted As Boolean

fItemDeleted = False
Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

For Each mobjAPPT In mobjFLDR.Items
If mobjAPPT.Start = datStart Then
mobjAPPT.Delete
fItemDeleted = True
Exit For
End If
Next

If fItemDeleted = False Then
MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly + vbExclamation, "Information"
End If

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

End Sub


Private Sub ExampleCall_DeletePermanently()

' Read note below!

Dim datApptStart As Date
Dim datDate As Date
Dim datTime As Date

' Delete (permanently) an appointment that
' starts on March 1, 2007, at 10:30 am:
datDate = DateSerial(2007, 3, 1)
datTime = TimeSerial(10, 30, 0)
datApptStart = datDate + datTime
Call PermanentlyDeleteAppointment(datApptStart)

End Sub

Private Sub PermanentlyDeleteAppointment(datStart As Date)

' This subprocedure needs a reference to the
' Microsoft CDO 1.21 Library.

' CDO is much faster and more reliable if looping
' through a large collection of items.

' This subprocedure will delete an appointment
' item and will *NOT* place it in the Deleted Items
' folder.

' This subprocedure can be modified to test for any known
' property or properties of the appointment item. As more
' than one appointment could start at the same time, it
' would be necessary to examine another property to
' determine which one should be deleted. Modify the "If"
' statement accordingly.

Dim fItemFound As Boolean
Dim strEntryID As String
Dim strStoreID As String

fItemFound = False
Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

' Loop through Calendar folder until the item with
' the incoming datStart is found:
For Each mobjAPPT In mobjFLDR.Items
If mobjAPPT.Start = datStart Then
fItemFound = True
Exit For
End If
Next

If fItemFound Then
GoTo DeleteAppointmentItemUsingCDO
Else
GoTo AppointmentItemNotFound
End If

Bye:

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

Exit Sub

DeleteAppointmentItemUsingCDO:

' Get EntryID from Outlook Appointment item:
strEntryID = mobjAPPT.EntryID

' Get Folder's storeID:
strStoreID = mobjFLDR.StoreID

' Logon to CDO:
Call DoCDOLogon

' Point MAPI object to Appointment Item:
Set mobjMAPIAppt = mobjCDOSession.GetMessage(strEntryID, _
strStoreID)

' Delete MAPI object:
mobjMAPIAppt.Delete

' Logoff from CDO (see note under DoCDOLogon):
Call DoCDOLogoff

GoTo Bye

AppointmentItemNotFound:

MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly + vbExclamation, "Information"

GoTo Bye

End Sub

Private Sub DoCDOLogon()

' If deleting many items, do not logon and logoff
' repeatedly to CDO in quick succession. Instead,
' modify the code to logon once at the beginning
' of a delete session and logoff at the end of
' the session.

If mobjCDOSession Is Nothing Then
Set mobjCDOSession = CreateObject("MAPI.Session")
mobjCDOSession.Logon , , False, False
End If

End Sub

Private Sub DoCDOLogoff()

' See note under DoCDOLogon.

If mobjCDOSession Is Nothing Then Exit Sub
mobjCDOSession.Logoff
Set mobjCDOSession = Nothing
Click to expand...
Click to expand...
 
You mentioned EntryID below. I originally was trying to use EntryID to
identify the exact appointment to delete, but was having trouble storing and
retrieving it. I tried storing it a table for each of the record I made the
appointment for as a text field, but that seems to be too short, so I changed
it to Memo field, but that doesn't seem to work either. Do you know what
field type this EntryID can be stored in an Access table? And yes I'm
interested in the code without using CDO as you mentioned..

GeoffG said:
Great!

One thing I noticed after posting was that, if you use Collaboration Data
Objects (CDO) to permanently delete an item, Outlook, alas, does not update
its Date-Navigation pane. (This pane is the small Outlook window where dates
get emboldened when they have an appointment set.) In other words, you may
permanently delete the last Appointment item on any given date using CDO,
but the relevant date will still be emboldened in the Date-Navigation Pane.

I think the text book that recommended the CDO approach did so on the basis
that, if you don't use CDO, then the deleted item goes into the Deleted
Items folder and you then have to delete it again from there. There seemed
to be a suggestion that this is tedious, hence the idea of using CDO to
delete an item in one fell swoop.

However, I've discovered (since posting) that it is extremely easy to make
the deletion from the Deleted Items folder - in fact I think it's probably
easier than using CDO. You simply need to store the StoreID and EntryID
(which are both very long strings) of the item you're deleting before you
delete it. Then, after deleting the item, you can delete it from the Deleted
Items folder in one line of code simply by using the StoreID and EntryID -
ie *without* referencing the Deleted-Items folder. This works because every
item in each store has a unique EntryID, regardless of what type of item it
is. By using this method (ie not using CDO), the Date-Navigation Pane does
get updated. If this is of interest to you and you can't figure what I mean,
post back and I'll look up the code example.

Regards
Geoff


dbornt said:
Geoff,
Thank you so much for the codes below. I've been trying to do this for
a
while, and haven't been able to get it to work. You're a life saver...

Thank you, thank you!!!!

GeoffG said:
To BW: I've not seen the Microsoft Office Outlook View Control before.
How do you get it to display the Calendar? I could only get it to display
the Inbox

To Keith: You asked for help with automation. As you don't say what
information you store in Access to keep track of Calendar items, I give
three demonstrations below, which you can copy and paste into an Access
module and modify to suit you best:

Demo 1 - How to delete an Appointment Item if you know its subject.

Demo 2 - How to delete an Appointment Item if you know its start
date/time.

Demo 3 - How to permanently delete an Appointment Item if you know its
start
date/time.

Demos 1 and 2 will move the deleted item to the Deleted Items folder.
Demo 3 won't.

You will have to modify these demos so as to uniquely identify the
Appointment Item you want to delete. For example, you could check the
appointment's start date/time *and* its subject heading. You could
additionally test for any other properties you have values for before you
invoke the delete method.

I recommend you backup your Outlook data file *before* running a program
that automatically deletes anything. Then get the program to delete one
item
to begin with and verify the program works as you expect.

Outlook stores its data in files with the filename extension *.pst. These
used to be known as personal store files. You can open the File menu and
select Data File Management to find out where these files are on your
hard
disc.

Geoff


Option Compare Database
Option Explicit

'------------------------------------------------------
' This Access module needs references to:
'
' Microsoft Outlook [VersionNo] Object Library
' Microsoft CDO 1.21 Library
'
' To set references, in the VBA Editor, open the
' Tools menu and select References.
'------------------------------------------------------


' OUTLOOK OBJECT VARIABLES:

Private mobjOLA As Outlook.Application
Private mobjNS As Outlook.NameSpace
Private mobjFLDR As Outlook.MAPIFolder
Private mobjAPPT As Outlook.AppointmentItem

' CDO (COLLABORATION DATA OBJECTS) VARIABLES:

Private mobjCDOSession As MAPI.Session
Private mobjMAPIAppt As MAPI.Message



Private Sub ExampleCall_DeleteBySubject()

' Read note below!

Dim strSubject As String

' Delete an appointment with the subject heading
' "My Test Appointment":
strSubject = "My Test Appointment"
Call DeleteAppointmentItemBySubject(strSubject)

End Sub

Private Sub DeleteAppointmentItemBySubject(strSubject As String)

' Use this method ONLY if the subject of the
' Appointment Item is known and is UNIQUE.

Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

On Error Resume Next
Set mobjAPPT = mobjFLDR.Items(strSubject)
If Err.Number <> 0 Then GoTo CannotFindObject
mobjAPPT.Delete

Bye:

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

Exit Sub

CannotFindObject:

MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly, "Information"
GoTo Bye

End Sub


Private Sub ExampleCall_NotPermanentDelete()

' Read note below!

Dim datApptStart As Date
Dim datDate As Date
Dim datTime As Date

' Delete (not permanently) an appointment that
' starts on March 1, 2007, at 9 am:
datDate = DateSerial(2007, 3, 1)
datTime = TimeSerial(9, 0, 0)
datApptStart = datDate + datTime
Call DeleteToDeletedFolder(datApptStart)

End Sub

Private Sub DeleteToDeletedFolder(datStart As Date)

' Use this subprocedure if you have the start date and time
' of the Appointment you want to delete.

' This subprocedure can be modified to test for any known
' property or properties of the appointment item. As more
' than one appointment could start at the same time, it
' would be necessary to examine another property to
' determine which one should be deleted. Modify the "If"
' statement accordingly.

' This subprocedure will place the deleted item in the
' Deleted Items folder.

' This subprocedure may be unsuitable if there are a
' large number of items in the Calendar folder (see
' using CDO below).

Dim fItemDeleted As Boolean

fItemDeleted = False
Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

For Each mobjAPPT In mobjFLDR.Items
If mobjAPPT.Start = datStart Then
mobjAPPT.Delete
fItemDeleted = True
Exit For
End If
Next

If fItemDeleted = False Then
MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly + vbExclamation, "Information"
End If

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

End Sub


Private Sub ExampleCall_DeletePermanently()

' Read note below!

Dim datApptStart As Date
Dim datDate As Date
Dim datTime As Date

' Delete (permanently) an appointment that
' starts on March 1, 2007, at 10:30 am:
datDate = DateSerial(2007, 3, 1)
datTime = TimeSerial(10, 30, 0)
datApptStart = datDate + datTime
Call PermanentlyDeleteAppointment(datApptStart)

End Sub

Private Sub PermanentlyDeleteAppointment(datStart As Date)

' This subprocedure needs a reference to the
' Microsoft CDO 1.21 Library.

' CDO is much faster and more reliable if looping
' through a large collection of items.

' This subprocedure will delete an appointment
' item and will *NOT* place it in the Deleted Items
' folder.

' This subprocedure can be modified to test for any known
' property or properties of the appointment item. As more
' than one appointment could start at the same time, it
' would be necessary to examine another property to
' determine which one should be deleted. Modify the "If"
' statement accordingly.

Dim fItemFound As Boolean
Dim strEntryID As String
Dim strStoreID As String

fItemFound = False
Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

' Loop through Calendar folder until the item with
' the incoming datStart is found:
For Each mobjAPPT In mobjFLDR.Items
If mobjAPPT.Start = datStart Then
fItemFound = True
Exit For
End If
Next

If fItemFound Then
GoTo DeleteAppointmentItemUsingCDO
Else
GoTo AppointmentItemNotFound
End If

Bye:

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

Exit Sub

DeleteAppointmentItemUsingCDO:

' Get EntryID from Outlook Appointment item:
strEntryID = mobjAPPT.EntryID

' Get Folder's storeID:
strStoreID = mobjFLDR.StoreID
Click to expand...
Click to expand...
Click to expand...
 
You mentioned EntryID below. I originally was trying to use EntryID to
identify the exact appointment to delete, but was having trouble storing
and
retrieving it. I tried storing it a table for each of the record I made
the
appointment for as a text field, but that seems to be too short, so I
changed
it to Memo field, but that doesn't seem to work either. Do you know what
field type this EntryID can be stored in an Access table? And yes I'm
interested in the code without using CDO as you mentioned..
Click to expand...

Both EntryID and StoreID are very long strings. It may be that the maximum
limit of 255 characters for a text field would be too small. (I don't know
for sure because I've never counted the number of characters in these
strings.) The memo field type should be OK. My guess would be that the
problem is not with the field type, but something else - perhaps the
StoreID. If you had the same appointment item on different machines, then I
think their EntryIDs and StoreIDs would be different, ie they are unique to
a specific machine. I think the StoreID is a unique string that identifies
the *.pst file on a given machine.

When I looked up my sample code today, I was reminded of yet another issue.
This may not be relevant to you but I mention it anyway because it adds
material information to the code I previously posted. This paragraph
explains this further issue and the demo code below shows how to work around
it. There appears to be a precision issue with the way VBA and Outlook store
times. VBA stores date/time serial numbers as real numbers, with the integer
portion (before the decimal point) representing the date, and the decimal
portion (after the decimal point) representing the time. Take the case of
using VBA's DateSerial() and TimeSerial() functions to create a date/time
for an appointment on, say, March 5, 2007 at 11:30 am and use VBA to create
an Appointment starting at that date/time. If you then get VBA to loop
through all the appointments until it finds an appointment starting at 11:30
on March 5, 2007, it *won't* find it. It seems that the time portion of the
Appointment item may use a different number of decimal places to the
TimeSerial() function. If you repeat this test, putting 11:00 am into the
TimeSerial() function, then VBA *will* find the appointment. Presumably,
this indicates that the degree of precision is immaterial for an 11:00 am
appointment, but is not immaterial for an 11:30 am appointment. The
workaround for this issue is that, when VBA loops through all the
appointments looking for an appointment that starts at a specific time, the
code needs to use a range of times, starting 1 second before, and ending 1
second after, the actual appointment time.

The following demo shows all this in action. CDO isn't used, so the
Date-Navigation pane is kept up-to-date. The Appointment item is deleted
from the Calendar folder and then from the Deleted-Items folder. The code
uses the GetItemFromID method to locate the item in the Deleted-Items
folder.

Regards
Geoff


' OUTLOOK OBJECT VARIABLES:

Private mobjOLA As Outlook.Application
Private mobjNS As Outlook.NameSpace
Private mobjFLDR As Outlook.MAPIFolder
Private mobjAPPT As Outlook.AppointmentItem


Private Sub ExampleCall_PermDelete2()

' DEMO 4

Dim strSubject As String
Dim datApptDateTime As Date

' Assumes there is an appointment with the
' following subject and date/time that needs
' to be deleted:

strSubject = "*** MY TEST APPOINTMENT ***"
datApptDateTime = DateSerial(2007, 3, 5) _
+ TimeSerial(11, 30, 0)

Call PermanentlyDeleteAppointment2(strSubject, datApptDateTime)

End Sub

Private Sub PermanentlyDeleteAppointment2( _
strSubject As String, _
datApptDateTime As Date)

' DEMO 4
'
' Use this demo to permanently-delete an Appointment
' when its subject and start Date/Time are known.

' This demo does not use CDO. This has the advantage
' of keeping Outlook's Date-Navigation Pane up-to-date.
'
' This demo also shows how to overcome (what appears
' to be) a precision issue with the way Outlook stores
' times by using a range 1 second before to 1 second
' after the incoming date/time.

Dim fItemDeleted As Boolean
Dim datRangeStart As Date
Dim datRangeEnd As Date
Dim strEntryID As String
Dim strStoreID As String

' Figure out Date/Time range within which the
' appointment must be (ie 1 second before to
' 1 second after the incoming date/time):
datRangeStart = DateAdd("s", -1, datApptDateTime)
datRangeEnd = DateAdd("s", 1, datApptDateTime)

' Get Outlook:
Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)
strStoreID = mobjFLDR.StoreID

' Initialise "Deleted" flag:
fItemDeleted = False

' Loop through all Appointments:
For Each mobjAPPT In mobjFLDR.Items
If mobjAPPT.Start > datRangeStart And _
mobjAPPT.Start < datRangeEnd And _
mobjAPPT.Subject = strSubject Then

' Item found so delete it and exit loop:
GoSub DeleteAppointmentItem
Exit For

End If
Next

' Show final message if not deleted:
If fItemDeleted = False Then
MsgBox "Cannot find Appointment Item to delete.", _
vbOKOnly + vbExclamation, "Information"
End If

Bye:

Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

Exit Sub

DeleteAppointmentItem:

' Store the Appointment Item's EntryID:
strEntryID = mobjAPPT.EntryID

' Delete the Appointment and send it
' to the Deleted-Items folder:
mobjAPPT.Delete

' Point to the Appointment Item in the
' Deleted-Items folder and delete it:
Set mobjAPPT = mobjNS.GetItemFromID(strEntryID, strStoreID)
mobjAPPT.Delete

' Set "Deleted" flag to True:
fItemDeleted = True

Return

End Sub
 
There appears to be a precision issue with the way VBA and Outlook store
times. VBA stores date/time serial numbers as real numbers, with the integer
portion (before the decimal point) representing the date, and the decimal
portion (after the decimal point) representing the time.
Click to expand...

VBA stores date/time serial numbers as a double float ('Double')
whereas 'real' implies 'Single'.

To test:

CREATE TABLE Test (
date_col REAL NOT NULL
)
;
INSERT INTO Test VALUES (#2007-04-01 00:08:00#)
;
SELECT DATEDIFF('s', date_col, #2007-04-01 00:08:00#)
FROM Test;

returns a difference of 142 seconds, which is quite a loss of
precision :(

Jamie.

--
 
Many thanks, Jamie.

I was using "real" in a mathematical, rather than compuer science sense. But
let's not quibble about definitions. What's really at issue here is that,
when you set an Outlook Appointment to a specific date and time using VBA,
you can't then use VBA to find the Appointment using the same date and
time - which at first sight seems bizarre; you can only find it using a
range of times. I don't know why this happens other than to speculate that
Outlook Appointment times may use a different degree of precision than does
the VBA Date data type.

If you're interested, the code sample below (designed to be run in Access)
attempts to demonstrate what I'm getting at. When I posted this code to an
Outlook Newsgroup, an Outlook MVP indicated that you should never use the
equals sign, but use a range of times instead.

If you know what's going on under the hood, I'd be very glad to hear.

Regards
Geoff


Option Compare Database
Option Explicit

Private mobjOLA As Outlook.Application
Private mobjNS As Outlook.NameSpace
Private mobjFLDR As Outlook.MAPIFolder
Private mobjAPPT As Outlook.AppointmentItem

Private Sub DemoAppointmentTimeProblem()

' This subprocedure was run in Outlook 2002.

' This subprocedure appears to demonstrate that
' there may be a precision or rounding issue
' concerning Outlook Appointment times.
'
' Appointments created on the hour are located
' but Appointments created on the half hour are
' not located.
'
' Why should this be?
' What's the solution?


Dim datStart As Date
Dim datDate As Date
Dim datTime As Date
Dim I As Integer

Call InitialiseOutlook

' This does work!
' Note the time is set for on the hour.
datDate = DateSerial(2007, 3, 5)
datTime = TimeSerial(11, 0, 0)
datStart = datDate + datTime
I = I + 1
Call CreateAppointment(I, datStart)

' This doesn't work!
' Note the time is set for 30 minutes past the hour.
datDate = DateSerial(2007, 3, 5)
datTime = TimeSerial(11, 30, 0)
datStart = datDate + datTime
I = I + 1
Call CreateAppointment(I, datStart)

Call CleanUp

End Sub

Private Sub InitialiseOutlook()

Set mobjOLA = CreateObject("Outlook.Application")
Set mobjNS = mobjOLA.GetNamespace("MAPI")
mobjNS.Logon , , False, False
Set mobjFLDR = mobjNS.GetDefaultFolder(olFolderCalendar)

End Sub

Private Sub CreateAppointment( _
intTestNo As Integer, _
datStart As Date)

Dim strSubject As String
Dim fFound As Boolean
Dim strMessage As String
Dim intButtons As Integer
Dim strHeading As String

strSubject = "*** TIME TEST ***"

' Create Appointment Item:
Set mobjAPPT = mobjOLA.CreateItem(olAppointmentItem)
mobjAPPT.Start = datStart
mobjAPPT.Subject = strSubject
mobjAPPT.ReminderSet = False
mobjAPPT.Save

' Search for Appointment Item:
fFound = False
For Each mobjAPPT In mobjFLDR.Items
If mobjAPPT.Start = datStart And _
mobjAPPT.Subject = strSubject Then
fFound = True
Exit For
End If
Next

' Evaluate the fFound flag:
If fFound Then
GoTo AppointmentItemFound
Else
GoTo AppointmentItemNotFound
End If

Bye:

Exit Sub

AppointmentItemFound:

' Show Found message:
strMessage = "Subject:" & vbTab & strSubject _
& vbNewLine _
& "Original:" & vbTab & datStart _
& vbNewLine _
& "Current:" & vbTab & mobjAPPT.Start _
& vbNewLine & vbNewLine _
& "The above Appointment Item exists and was found." _
& vbNewLine _
& "VBA compared the above Original and Current " _
& "Date/Times and found them to be the same. " _
& vbNewLine _
& "(Note - Times on-the-hour work.)" & vbNewLine _
& "The Appointment Item will now be deleted."
intButtons = vbOKOnly Or vbInformation
strHeading = "TEST NUMBER " & CStr(intTestNo) _
& " - SUCCESS!"
MsgBox strMessage, intButtons, strHeading

' Delete the Appointment Item:
mobjAPPT.Delete

GoTo Bye

AppointmentItemNotFound:

' Point to the existing Appointment Item we created:
Set mobjAPPT = mobjFLDR.Items(strSubject)

' Show Not Found message:
strMessage = "Subject:" & vbTab & strSubject _
& vbNewLine _
& "Original:" & vbTab & datStart _
& vbNewLine _
& "Current:" & vbTab & mobjAPPT.Start _
& vbNewLine & vbNewLine _
& "The above Appointment Item exists but was " _
& "not found!" & vbNewLine _
& "VBA compared the above Original and Current " _
& "Date/Times and found them to be different," _
& vbNewLine _
& "even though they appear to be the same." _
& vbNewLine _
& "(Note - Times on-the-half-hour don't work.)" _
& vbNewLine _
& "The Appointment Item will now be deleted."
intButtons = vbOKOnly Or vbCritical
strHeading = "TEST NUMBER " & CStr(intTestNo) _
& " - FAILED!"
MsgBox strMessage, intButtons, strHeading

' Delete the Appointment Item:
mobjAPPT.Delete

GoTo Bye

End Sub

Private Sub CleanUp()

' Clean up:
Set mobjAPPT = Nothing
Set mobjFLDR = Nothing
Set mobjNS = Nothing
Set mobjOLA = Nothing

End Sub
 
Back
Top