Hjælp til VBA: Opret aftale i Outlook

Hej Eksperter.

Jeg har fået lavet (med hjælp fra google) en kode, der opretter en aftale i min kalender baseret på en eller flere e-mail-adresser, men....

hvordan skal koden rettes så:
1: aftalen gemmes i sekretærens kalender "sekretær" (shared)
2: e-mail adresser erstattes med en distributionsgruppe

Ad 2: Kan løses med et LOPSLAG, men det vil være bedre, hvis gruppe kunne hentes direkte.

Mit regneark med kode kan hentes her: https://www.dropbox.com/s/cge0hziltpevpr9/outlook_appointment.xlsm?dl=0

Her er koden:
    Sub AddAppointments()

      Dim myoutlook As Object ' Outlook.Application
      Dim r As Long
      Dim myapt As Object ' Outlook.AppointmentItem
      Dim time As String

      ' 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
      '    .Subject = Cells(Row, Column)
          .Location = Cells(r, 2).Value
          .Start = Cells(r, 4).Value
          time = .Start
          .Duration = Cells(r, 5).Value
          .Recipients.Add Cells(r, 9).Value '& ";" & _
      '    Cells(8, 2).Value & ";" & _
      '    Cells(8, 3).Value & ";" & _
      '    Cells(8, 4).Value & ";" & _
      '    Cells(8, 5).Value & ";" & _
      '    Cells(8, 6).Value & ";" & _
      '    Cells(8, 7).Value & ";" & _
      '    Cells(8, 8).Value & ";" & _
      '    Cells(8, 9).Value & ";" & _
      '    Cells(8, 10).Value

          .MeetingStatus = olMeeting
          ' not necessary if recipients are email addresses
          myapt.Recipients.ResolveAll
          'myapt.Recipients.FreeBusy = "(#8/8/2015#, 60, False)"
        ' .AllDayEvent = Cells(9, 1).Value

          ' If Busy Status is not specified, default to 2 (Busy)
          If Len(Trim$(Cells(r, 6).Value)) = 0 Then
            .BusyStatus = olBusy
          Else
            .BusyStatus = Cells(r, 6).Value
          End If

          If Cells(r, 7).Value > 0 Then
            .ReminderSet = True
            .ReminderMinutesBeforeStart = Cells(r, 7).Value
          Else
            .ReminderSet = False
          End If

          .Body = Cells(r, 8).Value
          .Save
          r = r + 1
          .Display
        End With
      Loop
    End Sub