Stuck on VBA code to populate a specific Outlook Calendar from excel

[Rkeev]

Trying to populate an Outlook Calendar from excel but can't seem to get the correct calendar populated.
I want to populate an outlook calendar named "MyCal" but the code below only populates the calendar named "calendar" which is a default.
Again works great as long as I am populating the default but will not populate a specifically named calendar.
I am unsure it it is pst issue or??? but very frustrating.

Any help would be appreciated>
The below code was from a very old post on vbaexpress;

Code to populate Outlook Calendar from excel:

Sub AddAppointments()
'http://www.vbaexpress.com/forum/archive/index.php/t-53311.html
Dim olApp As Object
Dim olNs As Object
Dim olStore As Object
Dim olCal As Object
Dim objAppt As Object
Dim lastrow As Long
Dim xlSheet As Worksheet
Dim i As Long
Dim strStart As String
Dim strEnd As String
Const strCalendar As String = "MyCal"

'On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application")
'On Error GoTo 0

If Not olApp Is Nothing Then
Set olNs = olApp.GetNamespace("MAPI")
olNs.logon
For Each olStore In olNs.Folders
For Each olCal In olStore.Folders
If olCal.Name = strCalendar Then
Set xlSheet = Sheets(1)
With xlSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastrow
strStart = CDate(xlSheet.Range("B" & i)) & Chr(32) & CDate(xlSheet.Range("C" & i))
strEnd = CDate(xlSheet.Range("D" & i) & Chr(32) & CDate(xlSheet.Range("E" & i)))
Set objAppt = olCal.Items.Add(1)
With objAppt
.Subject = xlSheet.Range("A" & i)
.Start = strStart
.End = strEnd
.Body = xlSheet.Range("G" & i)
.Categories = xlSheet.Range("F" & i)
.ReminderSet = True
.AllDayEvent = False
.BusyStatus = 1
.Save
End With
Next i
End With
Exit For
Exit For
End If
Next olCal
Next olStore
End If
lbl_Exit:
Set olApp = Nothing
Set olNs = Nothing
Set olStore = Nothing
Set olCal = Nothing
Set objAppt = Nothing
Set xlSheet = Nothing
Exit Sub
End Sub

 

[John_w]

See if this thread starting at the linked post helps you.

Creating an Outlook Appointment in a shared calendar

Hi all, I am trying to write a VBA to create an Outlook Appointment in a shared calendar. The below code creates an appointment, but in my own default calendar. I would appreciate any help anyone can provide, as I am struggle to find an answer. Sub CalendarEntry() Dim OutApp As Object Dim...

www.mrexcel.com

 

[Rkeev]

See if this thread starting at the linked post helps you.

Creating an Outlook Appointment in a shared calendar

Hi all, I am trying to write a VBA to create an Outlook Appointment in a shared calendar. The below code creates an appointment, but in my own default calendar. I would appreciate any help anyone can provide, as I am struggle to find an answer. Sub CalendarEntry() Dim OutApp As Object Dim...

www.mrexcel.com

Thank you John, I tried to make sense of it, I could not.
I tried to augment a number of your methods that you provided in the link, but it did not work for me.

Even though the calendar I am trying to update is not a shared calendar, I still tried to run your code you provided to get the Shared calendar list; it also would not work for me.

Again the code I supplied works fine to add items to the default calendar but not with a specifically named calendar
I am guessing it has to do with this part of the code, but I am unsure how to redirect using the parent or other methods to get a specifically named calendar.

Set olNs = olApp.GetNamespace("MAPI")
olNs.logon
For Each olStore In olNs.Folders

 

[Rkeev]

See if this thread starting at the linked post helps you.

Creating an Outlook Appointment in a shared calendar

Hi all, I am trying to write a VBA to create an Outlook Appointment in a shared calendar. The below code creates an appointment, but in my own default calendar. I would appreciate any help anyone can provide, as I am struggle to find an answer. Sub CalendarEntry() Dim OutApp As Object Dim...

www.mrexcel.com

I figured it out But thank you John; your help directed me to a new path.

 

[GeorgeAustralia]

I figured it out But thank you John; your help directed me to a new path.

Hi Rakeev

Would you mind sharing how you eventually managed to solve the issue please?
Thank you.