Update Outlook Calendar from Access table

Hi

I am using the following code to update my Outlook calendar at the dates in my Access table.
I use the unique ID record in the subject. How would I update the code to firt delete any appointment with this ID

Sub LoadCalendarItems()

   Dim OlkApp As Outlook.Application
   Dim strSubject As String
   Dim rst As DAO.Recordset
   Dim db As DAO.Database
   Dim strDate As String
   Dim strTime As String
   Dim strEndDate As String
   Dim strBookingID As String
   
   Set db = CurrentDb
   Set rst = db.OpenRecordset("Bookings")
   Set OlkApp = New Outlook.Application
   With rst
      Do Until .EOF
         
         strDate = .Fields("Arrival Date")
         strTime = .Fields("Guest Arrival Time")
         strEndDate = .Fields("Departure Date")
         strSubject = .Fields("Guest Name")
         strBookingID = .Fields("ID")
         
         CreateCalendarItem OlkApp, strSubject, strDate, strTime, strEndDate, strBookingID
         .MoveNext
      Loop
      .Close
   End With
 
   ' Clean up.
   Set OlkApp = Nothing
   Set rst = Nothing
   Set db = Nothing
   
End Sub
 
Sub CreateCalendarItem(OlkApp As Outlook.Application, _
            strSubject As String, strDate As String, _
            strTime As String, strEndDate As String, strBookingID As String)
   Dim olkAppt As Outlook.AppointmentItem
   Dim dte As Date
   Dim EndDate As Date
   
   ' Must add Outlook to references for this to work
   dte = CDate(strDate & " " & strTime)
   EndDate = CDate(strEndDate & " " & "09:00:00 AM")
   
   With OlkApp
      Set olkAppt = .CreateItem(Outlook.OlItemType.olAppointmentItem)
      With olkAppt
         .Start = dte
         .End = EndDate
         .Subject = strBookingID & " " & strSubject
         .ReminderSet = False
         olkAppt.Save
      End With
   End With
   
   ' Clean up.
   Set olkAppt = Nothing
End Sub
Murray BrownMicrosoft Cloud Azure/Excel Solution DeveloperAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Chris BottomleySoftware Quality Lead EngineerCommented:
Hello murbro,

You could add the following sub and call it with the strBookingID .

Regards,
Chris
Sub calDelete(strSubjectStarter As String)
Const PropTag  As String = "http://schemas.microsoft.com/mapi/proptag/"
Dim olkApp As object
Dim olkNS As object
Dim myfolder As object
Dim olkCalitems As object
Dim itemCount As Integer
Dim appt As object
Dim strFilter As String
    
    On Error Resume Next
    
    Set olkApp = createobject("Outlook.Application")
    Set olkNS = olkApp.GetNamespace("MAPI")
    Set myfolder = olkNS.Session.GetDefaultFolder(9)
    strFilter = "@SQL=" & Chr(34) & PropTag _
        & "0x0037001E" & Chr(34) & " like " & Chr(39) & strSubjectStarter & "%" & Chr(39)
    Set olkCalitems = myfolder.items.Restrict(strFilter)
    itemCount = olkCalitems.count
    For Each appt In olkCalitems
        appt.delete
    Next
    
Set olkCalitems = Nothing
Set olkNS = Nothing
Set olkApp = Nothing
Set myfolder = Nothing
 
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Murray BrownMicrosoft Cloud Azure/Excel Solution DeveloperAuthor Commented:
thanks very much
0
Chris BottomleySoftware Quality Lead EngineerCommented:
Glad to help, thank's for the prompt response.

Chris
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Chris BottomleySoftware Quality Lead EngineerCommented:
murbro,

Just went to post my answer to your question on current appt rather than delete ... it's gone, I guess you solved it for yourself but I have the solution as I did it anyway if you want it?

chris_bottomley
0
Murray BrownMicrosoft Cloud Azure/Excel Solution DeveloperAuthor Commented:
Hi Chris. My mistake. I shouldn't have deleted it. I have reposted it at the link below.
Thanks
Murray

http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_24434216.html
0
Chris BottomleySoftware Quality Lead EngineerCommented:
I've posted an answer there. It may not be perfect for what you want but I presume you will indicate there how you would like it to work.

Chris
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.