Crear cita en Outlook desde Access 2007 eligiendo calendario

Question

Buenos días:
Utilizo Office 2007.
Gestiono en Outlook 3 cuentas de correo (la de mi unidad, la de mi superior y la mía) con sus correspondientes calendarios.
Trato de poder crear citas/reuniones en los calendarios desde un formulario de Access.

Lo he conseguido, pero me las crea todas en mi calendario (que es el del usuario, en este caso yo.)

¿Puedo elegir el calendario en el que quiero que se cree la cita/reunión?.

Pongo el código que funciona con mi usuario.

Dim objOutlook As Outlook.Application Dim objAppt As Outlook.AppointmentItem Set objOutlook = CreateObject("Outlook.Application") Set objAppt = objOutlook.CreateItem(olAppointmentItem) With objAppt .Start = Me.FechaInicio & " " & Me.HoraInicio .End = Me.FechaFin & " " & Me.HoraFin .Subject = Me.Asunto .Body = Me.Notas .Location = Me.Ubicacion .Save .Close (olSave) End With Set objAppt = Nothing Set objOutlook = Nothing 'Lanzamos mensaje deconfirmación MsgBox "Reunión/Cita creada en la agenda" Exit Sub Add_Err: MsgBox "Error " & Err.Number & vbCrLf & Err.Description Exit Sub

Fuerza y honor.
Saludos de Arturo desde Madrid

Answer 1

Esto es lo que me ha funcionado a mí. En concreto yo genero una reunión a una lista de asistentes (listadestinos) que son las direcciones de correo separadas por ';'

Por defecto, genera la reunión a los correos de listadestinos bajo el calendario de [e-mail]. Para que se genere bajo cuenta2:

Private Sub GenerarReunion(listadestinos)

          

    Dim OutlookApp As Outlook.Application
    Dim myNamespace As Outlook.NameSpace
    Dim myRecipient As Outlook.Recipient
    Dim calendarFolder As Outlook.MAPIFolder
    Dim items As Outlook.items
    Dim appItem As Outlook.AppointmentItem

    Set OutlookApp = CreateObject("Outlook.Application")
    Set myNamespace = OutlookApp.GetNamespace("MAPI")
    Set myRecipient = myNamespace.CreateRecipient("[e-mail]")
    Set calendarFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar)
    Set OutlookApp.ActiveExplorer.CurrentFolder = calendarFolder
    Set items = calendarFolder.items
    Set appItem = items.Add(Outlook.OlItemType.olAppointmentItem)

    With appItem

      .Start = Me.FechaInicio & "  " & Me.HoraInicio

      .End = Me.FechaFin & "  " & Me.HoraFin

      .Location = Me.CentroFormacion 'Localización de la cita
      .Subject = Me.CodCurso + Me.Tanda + " (" + Str(Me.Ejercicio) + ") " + Me.TipoCurso
      .Body = "Curso " + Me.TipoCurso + " - enviado desde Formación" 

      .OptionalAttendees = listadestinos
      .MeetingStatus = olMeeting   'para cambiar cita a reunión 
      .Save  'Salvamos la cita
      .Display  'La mostramos para su personalización/modificación
    End With

End Sub