Hi Everyone,
So I have a code that creates and sends off Outlook meetings based on data that I put into Excel. However this will create the meetings in my default/personal calendar.
Under My Calendars, I have another Calendar that myself and my colleagues have access to and the path is "\\Training\Calendar"
How can I tweak my code to so it creates and save the meetings in the Training Calendar instead of my default (personal) one?
Below are my codes that I copied from the internet and tweak it for my own purposes.
Thanks,
H
Here is my code so far.
Sub AddAppointments()
Dim myoutlook As Object ' Outlook.Application
Dim r As Long
Dim myapt As Object ' Outlook.AppointmentItem
' late bound constants
Const olAppointmentItem = 1
Const olBusy = 2
Const olMeeting = 1
' Create the Outlook session
Set myoutlook = CreateObject("Outlook.Application")
' Start at row 2
r = 2
Do Until Trim$(Cells(r, 1).Value) = ""
' Create the AppointmentItem
Set myapt = myoutlook.CreateItem(olAppointmentItem)
' Set the appointment properties
'
With myapt
.Subject = Cells(r, 1).Value
.Location = Cells(r, 2).Value
.Start = Cells(r, 3).Value + Cells(r, 4).Value
.End = Cells(r, 3).Value + Cells(r, 5).Value
.Recipients.Add Cells(r, 7).Value
.MeetingStatus = olMeeting
' not necessary if recipients are email addresses
' myapt.Recipients.ResolveAll
'.AllDayEvent = Cells(r, 9).Value
' If Busy Status is not specified, default to 2 (Busy)
If Len(Trim$(Cells(r, 5).Value)) = 0 Then
.BusyStatus = olBusy
Else
.BusyStatus = Cells(r, 5).Value
End If
.Body = Cells(r, 8).Value
.Save
r = r + 1
.Send
End With
Loop
MsgBox ("Meetings Sent")
End Sub
Bookmarks