0

Good afternoon,

I have been struggling with synchronization with the Outlook calendar with MS Excel. I want exactly to have my cells with date appeared in this calendar as the events.

The best code, which I found for this purpose comes from here:

Excel Create an Outlook calendar event

However, the question is closed, as the code is incomplete.

Trying this code on my example

 Sub Calendaroutlookevent()

 Dim objOutlook As Outlook.Application
 Dim objNamespace As Outlook.Namespace
 Dim items As Outlook.Folder, objCalendar As Outlook.Folder, objapt As Outlook.Folder
 Dim wb As Workbook
 Dim ws As Worksheet
 Dim Dt As Date

 Set wb = ThisWorkbook
 Set ws = wb.Sheets("Sheet1")
 Set Dt = ws.Range("B2:C6")  ' Dates with surveyors included. Maybe some Match option here?


 Const olFolderCalendar = 9
 Const olAppointmentItem = 1 '1 = Appointment

 Set objOutlook = CreateObject("Outlook.Application")

'Set objOutlook = GetObject(, "Outlook.Application")  ' outlook already open
 Set objNamespace = objOutlook.GetNamespace("MAPI")
 Set items = objNamespace.GetDefaultFolder(olFolderCalendar).items

 Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar).Folders("subfolder")
 Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar) ' main calender
 Set objapt = objCalendar.items.add(olAppointmentItem)
 objapt.Subject = "Test" 'Owner
 objapt.Start = Dt + TimeValue("08:00:00")
 objapt.Duration = 60 * 8 'Duration(in minutes) OR End(I'm not sure so try both)
 objapt.End = Dt + TimeValue("16:00:00")
 objapt.Save

 End Sub

Now the debugger shows "Object required" pointing the line: Set Dt = ws.Range("C2:C6")

enter image description here

If I keep the original statement with Date, as per below then

 Sub Calendaroutlookevent()

 Dim objOutlook As Outlook.Application
 Dim objNamespace As Outlook.Namespace
 Dim items As Outlook.Folder, objCalendar As Outlook.Folder, objapt As Outlook.Folder


 Const olFolderCalendar = 9
 Const olAppointmentItem = 1 '1 = Appointment

 Set objOutlook = CreateObject("Outlook.Application")

 'Set objOutlook = GetObject(, "Outlook.Application")  ' outlook already open
 Set objNamespace = objOutlook.GetNamespace("MAPI")
 Set items = objNamespace.GetDefaultFolder(olFolderCalendar).items

 Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar).Folders("subfolder")
 Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar) ' main calender
 Set objapt = objCalendar.items.add(olAppointmentItem)
 objapt.Subject = "Test" 'Owner
 objapt.Start = Date + TimeValue("08:00:00")
 objapt.Duration = 60 * 8 'Duration(in minutes) OR End(I'm not sure so try both)
 objapt.End = Date + TimeValue("16:00:00")
 objapt.Save

 End Sub

Then debuggers say "Type-mismatch" for the following line:

 Set items = objNamespace.GetDefaultFolder(olFolderCalendar).items

Another option comes from here:

Determining selected Outlook Calendar date with VBA

but even if I use this pure code, I am getting the error: "Object doesn't support this property or method" pointing the line:

    Set oExpl = Application.ActiveExplorer

How can I solve this problem and make my dates appeared on the Outlook Calendar? Can I expand my range including the Surveyor name also?

Thanks & Regards

UPDATE:

The newest version of my code looks as follows:

 Sub Calendaroutlookevent()

 Dim objOutlook As Outlook.Application
 Dim objNamespace As Outlook.Namespace
 Dim items As Outlook.items
 Dim objCalendar As Outlook.Folder, objapt As Outlook.Folder


  Const olFolderCalendar = 9
  Const olAppointmentItem = 1 '1 = Appointment

 Set objOutlook = CreateObject("Outlook.Application")

 'Set objOutlook = GetObject(, "Outlook.Application")  ' outlook already open
 Set objNamespace = objOutlook.GetNamespace("MAPI")
 Set items = objNamespace.GetDefaultFolder(olFolderCalendar).items

 Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar) ' main 
  calender
 Set items = objCalendar.items
 Set objapt = items.add(olAppointmentItem)

 objapt.Subject = "Test" 'Owner
 objapt.Start = Date + TimeValue("08:00:00")
 objapt.Duration = 60 * 8 'Duration(in minutes) OR End(I'm not sure so try 
 both)
 objapt.End = Date + TimeValue("16:00:00")
 objapt.Save

 End Sub

I am getting Type Mismatch, as debugger highlights the line:

 Set objapt = items.add(olAppointmentItem)
Geographos
  • 827
  • 2
  • 23
  • 57
  • `Set dt` doesn't make sense because a `Date` is not an `Object` variable and doesn't require `Set`... but the right-hand side of that line is a `Range` anyway. – BigBen May 20 '20 at 14:00
  • So shall I replace the Date with my range? – Geographos May 20 '20 at 14:02
  • 1
    I'm not sure exactly what you want to do but it seems like you need a loop through that range. – BigBen May 20 '20 at 14:02
  • I want to have all these dates populated in the outlook calendar with their planners, when possible. When it's not feasible, then I will be happy with one date. – Geographos May 20 '20 at 14:04

1 Answers1

1

First of all, you need to declare objects properly:

Dim items As Outlook.Items

Second, there is no need to access the same objects twice:

Set items = objNamespace.GetDefaultFolder(olFolderCalendar).items

Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar).Folders("subfolder")
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar) ' main calender
Set objapt = objCalendar.items.add(olAppointmentItem)

You can use the following code instead:

Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar) ' main calender
Set items = objCalendar.Items
Set objapt = items.add(olAppointmentItem)

objapt.Subject = "Test" 'Owner
objapt.Start = Date + TimeValue("08:00:00")
objapt.Duration = 60 * 8 'Duration(in minutes) OR End(I'm not sure so try both)
objapt.End = Date + TimeValue("16:00:00")
objapt.Save

Finally, you may find the Getting started with VBA in Office article helpful.

Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45