I know there's additional stuff in the Declarations, it's for other macros I've written.
I've several calendars. I've a spreadsheet where I paste information about a site, and I've buttons that generate appointments and emails.
I've code to set an appointment, however it goes to my main calendar. I'm trying to get the appointment onto my other calendars. I've read about MAPI functions, but can't get it to work. The location is \myemail@me.com\Calendar. Name of the calendar is SVN Calendar.
Dim olApp As Outlook.Application9
Dim olEmail As Outlook.MailItem
Dim olCal As Outlook.AppointmentItem
Dim olFolder As Outlook.Folder
Dim RequiredAttendee, OptionalAttendee, ResourceAttendee As Outlook.Recipient
Dim rtf() As Byte
Dim rngTo As Range
Dim rngCC As Range
Dim rngSUB As Range
Dim rngCALloc As Range
Dim rngCALstart As Range
Dim rngCALend As Range
Dim rngBody As Range
Dim myItem As Object
Sub newTestCreateCalendarUSA1()
'Testing calendar to other calendar than main.
' i.e. SVN Calendar. can't identify the actual calendar.
Set olApp = New Outlook.Application
Set m = olApp.CreateItem(olMailItem)
Set appt = olApp.CreateItem(olAppointmentItem)
With ActiveSheet
Set rngCC = .Range("I34")
Set rngCALloc = .Range("I5")
Set rngCALstart = .Range("I11")
Set rngCALend = .Range("I12")
Set rngSUB = .Range("I33")
Set rngSite = .Range("C2")
Set rngLoc = .Range("C4")
Set rngTYPE = .Range("B23")
Set rngGON = .Range("C23")
Set rngPurpose = .Range("C21")
Set rngGoals = .Range("C22")
Set rngDate = .Range("I1")
Set rngDateStart = .Range("I8")
Set rngDateEnd = .Range("I9")
Set rngTime = .Range("I10")
Set rngCAS = .Range("C26")
End With
MsgBox "Ensure all attendees are correct prior to sending invite."
appt.MeetingStatus = olMeeting
appt.RequiredAttendees = rngCC.Value
appt.Subject = rngSUB.Value
appt.Location = rngCALloc.Value
appt.Start = rngCALstart.Value
appt.End = rngCALend.Value
appt.AllDayEvent = True
m.BodyFormat = olFormatHTML
m.HTMLBody = Range("I31").Value
m.GetInspector().WordEditor.Range.FormattedText.Copy
appt.GetInspector().WordEditor.Range.FormattedText.Paste
appt.Display
m.Close False
End Sub
Edit: Thanks for directing me to follow the folder tree. I tried understanding the GetNameSpace thing, but couldn't get it to work.
I did find a different code and got it to make an appointment on the correct calendar.
Sub SVN_Calendar_Invite()
'trial run of SVN Calendar with other code
Dim oApp As Object
Dim oNameSpace As Namespace
Dim oFolder As Object
Set oApp = New Outlook.Application
Set oNameSpace = oApp.GetNamespace("MAPI")
Set oFolder = oNameSpace.GetFolderFromID("0000000098F32312526B334EAEC97D94705E33FB0100C964D8D325E3554DA24A72FB876E3F600001912394000000")
With ActiveSheet
Set rngCC = .Range("I34")
Set rngCALloc = .Range("I5")
Set rngCALstart = .Range("I11")
Set rngCALend = .Range("I12")
Set rngSUB = .Range("I33")
Set rngSite = .Range("C2")
Set rngLoc = .Range("C4")
Set rngTYPE = .Range("B23")
Set rngGON = .Range("C23")
Set rngPurpose = .Range("C21")
Set rngGoals = .Range("C22")
Set rngDate = .Range("I1")
Set rngDateStart = .Range("I8")
Set rngDateEnd = .Range("I9")
Set rngTime = .Range("I10")
Set rngCAS = .Range("C26")
End With
With oFolder
Set olApt = oApp.CreateItem(olAppointmentItem)
With olApt
.AllDayEvent = True
.RequiredAttendees = rngCC.Value
.Start = rngDateStart.Value
.End = rngDateEnd.Value
.Subject = rngSUB.Value
.Location = rngLoc.Value
.Body = "The body of your appointment note"
.BusyStatus = olFree
.Save
.Move oFolder
End With
Set olNS = Nothing
Set olApp = Nothing
Set olApt = Nothing
End With
End Sub
I've these problems now.
1- if I use .Display to bring up the calendar item to review it, it doesn't display.
2- even though it's an all day event, and the cells are 3 days apart, it subtracts the end date by 1 day.
3- I have to manually invite the attendees, which defeats the purpose of doing this invite.
