Create a Outlook Calendar from Excel in a named calendar that is not the default one-CodePudding

I have created the below code that works well to create an Outlook calendar event with specific info from cells and it works great. I just need to change it from m default calendar to a different named calendar. I am not great with VBA and am still learning so this may be rough looking but all i need to know is what i need to add in order to have this create an event in a named calendar "Test" instead of my default outlook calendar, (also this is many edits in so some of the code may not be used but if it didn't break it i haven't removed it ie. this used to also send an email to recipients but i no longer have it do that )

Sub CreateAppointmentBuildVhub()
' Outlook application object.

'FOR CALENDAR ONLY
Dim objOL       As Object
' Appointment item object.
Dim objItem     As Object
' TimeZone object that represents "Eastern Standard Time" in Outlook.
Dim tzEastern   As Object
'FOR CALENDAR AND EMAIL
Dim AWorksheet As Worksheet
'FOR EMAIL ONLY
Dim Sendrng As Range
Dim Rng As Range

   
'FOR CALENDAR ENTRY
Set objOL = GetObject(, "Outlook.Application")
Set tzEastern = objOL.TimeZones.Item("Eastern Standard Time")
Set objItem = objOL.CreateItem(1)
Set AWorksheet = ActiveSheet
'FOR EMAIL SEND
   

With objItem
    .Start = Worksheets("Info").Range("C14").Text
    .StartTimeZone = tzEastern
    
    .Body = Worksheets("Info").Range("C2") & Chr(10) & Worksheets("Info").Range("C3") & Chr(10) & Worksheets("Info").Range("C4") & Chr(10) & Chr(10) & Worksheets("Info").Range("E2") & Chr(10) & Worksheets("Info").Range("E3")
    .Location = Worksheets("Info").Range("C3")
    .AllDayEvent = True
    .Subject = Worksheets("Info").Range("B14")
    .ReminderMinutesBeforeStart = 15
    .ReminderSet = False
    .Display
End With
Set objItem = Nothing
Set objOL = Nothing
Set tzEastern = Nothing

'Activate the sheet that was active before you run the macro AWorksheet.Select

'STOPS SCRIPT IF ERRORS

End Sub

CodePudding user response：

Instead of calling Application.CreateItem(olAppontment), you need to call MAPIFolder.Items.Add on the folder where the appointment needs to be created.

Assuming "Test" is a subfolder of the default Calendar folder:

set folder = objOL.Session.GetDefaultFolder(olFolderCalendar).Folders("Test")
Set objItem = folder.Items.Add

CodePudding user response：

this did exactly what i needed. Thank you

enter code hereSub CreateAppointmentBuildVhub() ' Outlook application object.

'FOR CALENDAR ONLY
Dim objOL       As Object
' Appointment item object.
Dim objItem     As Object
' TimeZone object that represents "Eastern Standard Time" in Outlook.
Dim tzEastern   As Object
'FOR CALENDAR AND EMAIL
Dim AWorksheet As Worksheet
'FOR EMAIL ONLY
Dim Sendrng As Range
Dim Rng As Range

   
'FOR CALENDAR ENTRY
Set objOL = GetObject(, "Outlook.Application")
Set tzEastern = objOL.TimeZones.Item("Eastern Standard Time")

Set AWorksheet = ActiveSheet
'FOR EMAIL SEND
Set Folder = objOL.Session.GetDefaultFolder(olFolderCalendar).Folders("Test")
Set objItem = Folder.Items.Add

With objItem
    .Start = Worksheets("Info").Range("C14").Text
    .StartTimeZone = tzEastern
    
    .Body = Worksheets("Info").Range("C2") & Chr(10) & Worksheets("Info").Range("C3") & Chr(10) & Worksheets("Info").Range("C4") & Chr(10) & Chr(10) & Worksheets("Info").Range("E2") & Chr(10) & Worksheets("Info").Range("E3")
    .Location = Worksheets("Info").Range("C3")
    .AllDayEvent = True
    .Subject = Worksheets("Info").Range("B14")
    .ReminderMinutesBeforeStart = 15
    .ReminderSet = False
    .Display
End With
Set objItem = Nothing
Set objOL = Nothing
Set tzEastern = Nothing

'Activate the sheet that was active before you run the macro AWorksheet.Select

'STOPS SCRIPT IF ERRORS

End Sub