Creating Outlook Calendar Invitation in Excel

[Kellogg]

Dear Great Minds of Excel,

I have a user form that creates an outlook calendar event. I want to be able to send an invitation of this event to an email address with an attached ics file. The code below will create the event but I'm stumped on how to create the invitation and create the ics attachment. Any help would be greatly appreciated. Thanks in advance.

'!! Reference to Outlook object library required !!
Const olAppointmentItem As Long = 1
Dim olApp As Object
Dim OLNS As Object
Dim OLAppointment As Object
Dim ws1 As Worksheet
Dim time1 As String
Dim time2 As String
Dim TimeAndDate
Dim N As Integer
dim cbxEventActivityTitle
cbxEventActivityTitle = "Test Activity"
'
time1 = Format(Now(), "MM/DD/YYYY")
time2 = Application.InputBox(prompt:="Enter time you would like to schedule reminder for (hh:mm)", Type:=1)
TimeAndDate = time1 + " " + Format(time2, "hh:mm")
'MsgBox TimeAndDate
'time1 = ws1.Range("AA2").Value
'
N = 1
'
Set ws1 = ActiveSheet 
'
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
'
'
Set OLAppointment = olApp.CreateItem(olAppointmentItem)
'
OLAppointment.Subject = cbxEventActivityTitle + " Update Reminder" 
OLAppointment.Start = DateAdd("d", N, TimeAndDate) 'Now() 
OLAppointment.Duration = 15
OLAppointment.Location = "iWERX" 
OLAppointment.Categories = "cAction Item" 
OLAppointment.Body = cbxEventActivityTitle + ": Assigned " + tbxEntryDate + " to " + cbxParticipantsInitials1 + ". Status - " + cbxTypeofActivity
OLAppointment.Save
'
'
OLAppointment.MeetingStatus = olMeeting
OLAppointment.Recipients.Add ("Your Email")
OLAppointment.Send
'
'
Set OLAppointment = Nothing
Set OLNS = Nothing
Set olApp = Nothing
End If
'

'


/s/

Craig