delete outlook calendar appointment from access

I have looked at a number of 'solutions' for this on here and other web sites, but none seem to work for me. I have code below to add an appointment from access (2007) to shared calendar. I need to be able to delete appointment from access. Any help would be appreciated.

Set outobj = CreateObject("outlook.application")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objRecip = objNS.CreateRecipient(strName)

Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)

If Not objFolder Is Nothing Then
    Set objAppt = objFolder.Items.Add
    
    If objAppt Is Nothing Then
        Set objAppt = objApp.CreateItem(olAppointmentItem)
    End If
    
    
Else
    MsgBox "no access to the folder meaning it is not shared"
End If

 With objAppt
    .Start = Format(AppStartDate, "Short Date") & " " & Format(Appstarttime, "Short Time")
    .End = Format(AppEndDate, "Short Date") & " " & Format(Appendtime, "Short Time")
    .Location = AppLocation
    .Subject = AppSubject & " - " & AppBusiness
    Body = "Client: " & AppBusiness & vbCrLf & "No of Attendees " & AppNoOfDelegates
    Body = Body & vbCrLf & "Contact Name: " & ContactName
    Body = Body & vbCrLf & "Contact Tele: " & ContactNumber
    Body = Body & vbCrLf & "Contact Email: " & ContactEmail
   .Body = Body
            
    .Save

Open in new window



Above adds the appointment to the shared calendar, but how can I search for and delete appointment (using vba from access)
LVL 3
foxpc123Asked:
Who is Participating?
 
David LeeConnect With a Mentor Commented:
foxpc123,

Sorry to be so slow to get back to you.  

I don't know why olkApp would be set to Nothing.  What version of Outlook are you using?

You're right, I was getting the local calendar instead of a shared calendar.  I've corrected the code.  Please give this version a try.

Sub DeleteAppointment(strName As String, strSubj As String)
    Const olFolderCalendar = 9
    Dim olkApp As Object, olkSes As Object, olkRcp As Object, olkFld As Object, olkApt As Object
    Set olkApp = CreateObject("Outlook.Application")
    Set olkSes = olkApp.GetNamespace("MAPI")
    olkSes.Logon olkApp.DefaultProfileName
    Set olkRcp = olkSes.CreateRecipient(strName)
    Set olkFld = olkSes.GetSharedDefaultFolder(olkRcp, olFolderCalendar).Items
    Set olkApt = olkFld.Find("[Subject] = '" & strSubj & "'")
    If TypeName(olkApt) <> "Nothing" Then
        olkApt.Delete
    End If
    olkSes.Logoff
    Set olkApt = Nothing
    Set olkFld = Nothing
    Set olkRcp = Nothing
    Set olkSes = Nothing
    Set olkApt = Nothing
End Sub

Open in new window

0
 
David LeeCommented:
Hi, foxpc123.

This should do it.  Pass this routine the name of the recipient and the subject of the appointment.  I'm assuming that the subject is unique (i.e. only one appointment with the subject).  If the subject isn't unique, then we'll need to make some changes to the code.

Sub DeleteAppointment(strName As String, strSubj As String)
    Const olFolderCalendar = 9
    Dim olkApp As Object, olkSes As Object, olkRcp As Object, olkFld As Object, olkApt As Object
    Set olkApp = CreateObject("Outlook.Application")
    Set olkSes = olkApp.GetNamespace("MAPI")
    olkSes.Logon olkApp.DefaultProfileName
    Set olkRcp = olkSes.CreateRecipient(strName)
    Set olkFld = olkSes.GetDefaultFolder(olFolderCalendar).Items
    Set olkApt = olkFld.Find("[Subject] = '" & strSubj & "'")
    If TypeName(olkApt) <> "Nothing" Then
        olkApt.Delete
    End If
    olkSes.Logoff
    Set olkApt = Nothing
    Set olkFld = Nothing
    Set olkRcp = Nothing
    Set olkSes = Nothing
    Set olkApt = Nothing
End Sub

Open in new window

0
 
foxpc123Author Commented:
Thanks BlueDevilFan. Will give it a try. However the Subject wasn't unique as it was a title of training course. However I can add a unique ID number to identify it.
0
 
David LeeCommented:
You're welcome.

If the subject isn't unique, then the best we could do is delete all appointments with that subject or delete those within a certain date range.
0
 
foxpc123Author Commented:
BlueDevilFan,

Tried your suggestion, didn't seem to work. OlkApp was always set to nothing, even though strname was set to shared calendar name and strSubj was set to subject on appointment.

Is your solution for a shared calendar ?

Not sure about:
Const olFolderCalendar = 9

Open in new window

and
 Set olkFld = olkSes.GetDefaultFolder(olFolderCalendar).Items

Open in new window


Your code deletes the appointment from the default calendar and not the shared calendar (name stored in strName)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.