Managing outlook appointments

[Shaun]

Hi All

I have been tasked with challenge, manage a client list in Excel that will also manage Outlook appointments.

I have found some code which I have superficially altered:

Option Explicit
Sub AddToOutlook()
   
   
  Dim OL As Outlook.Application
  Dim olAppt As Outlook.AppointmentItem
  Dim NS As Outlook.Namespace
  Dim colItems As Outlook.Items
  Dim olApptSearch As Outlook.AppointmentItem
  Dim r As Long, sSubject As String, sBody As String, sLocation As String
  Dim dStartTime As Date, dEndTime As Date, dReminder As String, dCatagory As Double
  Dim sSearch As String, bOLOpen As Boolean
   
  Worksheets("Sheet1").Activate
   
  On Error Resume Next
  Set OL = GetObject(, "Outlook.Application")
  bOLOpen = True
  If OL Is Nothing Then
  Set OL = CreateObject("Outlook.Application")
  bOLOpen = False
  End If
  Set NS = OL.GetNamespace("MAPI")
  Set colItems = NS.GetDefaultFolder(olFolderCalendar).Items
   
  For r = 2 To 20
  Debug.Print r
   
  If Len(Sheet1.Cells(r, 1).Value) < 1 Then GoTo NextRow
   
  dStartTime = Sheet1.Cells(r, 1).Value + Sheet1.Cells(r, 2).Value
  sSubject = Sheet1.Cells(r, 3).Value
  dEndTime = Sheet1.Cells(r, 4).Value
  sLocation = Sheet1.Cells(r, 5).Value

  sSearch = "[Subject] = " & sQuote(sSubject)
  Set olApptSearch = colItems.Find(sSearch)
   
  If olApptSearch Is Nothing Then
  Set olAppt = OL.CreateItem(olAppointmentItem)
  olAppt.Subject = sSubject
  olAppt.Start = dStartTime
  olAppt.End = dEndTime
  olAppt.Location = sLocation
  olAppt.Close olSave
  End If
   
NextRow:
  Next r
   
  If bOLOpen = False Then OL.Quit
   
End Sub
Function sQuote(sTextToQuote)
  sQuote = Chr(34) & sTextToQuote & Chr(34)
Debug.Print sQuote
End Function

Which allows me to enter the appointments in to Excel, but I need it to also be able to search subject (which it already does when adding appointments), date and start time and provide the user the ability to update the scheduled appointment to match the Excel appointment or delete it the appointment if it no longer exists in the Excel appointment list. I think there needs to be some sort of user confirmation of any changes to appointments for cases of inadvertent changes.

Does anyone have any idea as to how this could be done?

A sample file is attached.

Cheers

Shaun

 

[Shaun]

Hi Guys

Anyone have any ideas?

Cheers

Shaun

 

[Shaun]

Hi Guys

I have persevered and have cobbled together an appointment management tool.

It is entirely user driven via:

msgbox

so that nothing will be changed unless the user wants a particular appointment altered.

I have included a unique identifier when an appointment is added in the subject so that other appointment arranged independently from the spreadsheet are not considered.

If you take a look at this, I have only used 4 variables (5 in the spreadsheet) to get a working tool going, additional fields can be easily added.

If anyone can see a better way to do something please let me know, I am always looking to build on my VBA knowledge.

I hope it is useful to other people.

Cheers

Shaun