Create Outlook Event on non-default Calendar

[bru_giusti]

Dear,

I am using the code below to create events on my own calendar but I need to the events be create and sent my my secondary email. Can you help me to change the code so my secondary email and calendar are used when creating the event?

Sub SendEvent()


  Dim myoutlook As Object ' Outlook.Application
  Dim r As Long
  Dim myapt As Object ' Outlook.AppointmentItem
  'Dim Ns As Outlook.Namespace
 
 
  Const olAppointmentItem = 1
  Const olBusy = 2
  Const olMeeting = 1


  ' Create the Outlook session
  Set myoutlook = CreateObject("Outlook.Application")
  ' Start at active cell
  r = ActiveCell.Row
  
  ' Create the AppointmentItem
    Set myapt = myoutlook.CreateItem(olAppointmentItem)
    ' Set the appointment properties
    With myapt
           
      .Subject = "Application Confirmation - GON:" & Cells(r, 2).Value
      .Location = Cells(r, 18).Value
      .Start = Cells(r, 4).Value
      .End = Cells(r, 5).Value
      .Recipients.Add Cells(r, 28).Value
      .MeetingStatus = olMeeting
      .BusyStatus = olBusy
      .AllDayEvent = True
      .Body = Cells(r, 11).Value
      .Display
         
      
      End With
    End Sub