Scheduling Holidays and Appointments for the entire company - pushing them out to everyone's calendar

Dim oApp As Microsoft.Office.Interop.Outlook.Application
    Dim golNameSpace As Microsoft.Office.Interop.Outlook.NameSpace
    Dim oAppt As Microsoft.Office.Interop.Outlook.AppointmentItem
    Dim oldRecipient As Microsoft.Office.Interop.Outlook.Recipient
    Dim olCalendar As Microsoft.Office.Interop.Outlook.MAPIFolder 
Public Sub PushToCalendar(ByVal UserName As String, ByVal TheAppointment As clsAppointment)
' clsAppointment is a class that carries the appointment info.
' values could be passed as parameters to this sub instead,
' entered directly below into the appointment properties
        oApp = New Microsoft.Office.Interop.Outlook.Application
        golNameSpace = oApp.GetNamespace("MAPI")
 
        Try
            oldRecipient = golNameSpace.CreateRecipient(UserName)
            olCalendar = golNameSpace.GetSharedDefaultFolder(oldRecipient, OlDefaultFolders.olFolderCalendar)
            oAppt = olCalendar.Items.Add
 
            oAppt.Subject = TheAppointment.ApptSubject
            oAppt.Body = TheAppointment.ApptText
            oAppt.Start = TheAppointment.ApptStartDate
            oAppt.End = TheAppointment.ApptEndDate
            oAppt.ReminderSet = TheAppointment.ApptReminderSet
            oAppt.BusyStatus = Microsoft.Office.Interop.Outlook.OlBusyStatus.olOutOfOffice
            oAppt.IsOnlineMeeting = TheAppointment.ApptOnline
            oAppt.AllDayEvent = TheAppointment.ApptAllDay
 
            ' Save to Calendar. 
            oAppt.Save()
        Catch
            MsgBox("[" & Err.Number & "] Error Saving Appointment: " & Err.Description)
        End Try
    End Sub