Citas Calendarios Personalizados VBA
Desde Office Excel podemos crear, establecer citas en éstos calendarios personalizados de una manera muy rápida, utilizando código Vba.
Sin embargo vienen estas instrucciones pero no lo hacer que funcione:
El método CreateItem utiliza la carpeta principal del tipo de objeto (correo, cita, etc.) :
Set miCita = miOutlook.CreateItem(1)
Por lo que para establecer citas (ó items) en una "determinada" (sub)carpeta, seria necesario
Crear el objeto en la carpeta principal (según su tipo) y después "moverlo" a la (sub)carpeta específica (CreateItem)
Crear el objeto en la (sub)carpeta determinada por la colección <carpeta>. Items. Add (tipo) (NO por el método CreateItem)
Cómo resultado, el código usando "late binding" :
Sub Agendar_en_miCalendario() Dim miOutlook AsObject, miCalendario AsObject, miCita AsObject, _ Fila As Integer, uFila As Integer uFila = Range("a65536").End(xlUp).Row On Error GoTo Crear Set miOutlook = GetObject(, "outlook.application") If Err = 0 ThenGoTo Creado Crear: Err.Clear Set miOutlook = CreateObject("outlook.application") Creado: On Error GoTo0 For Fila = 2 To uFila ' en la col-B se tienen los nombres de los calendarios Set miCalendario = miOutlook.Session.GetDefaultFolder(9).Folders.Item(Range("b" & Fila).Text) Set miCita = miCalendario.Items.Add(1) ' en la col-A se tienen los identificadores del recordatorio/cita miCita.Subject = "Vencimiento de: " & Range("a" & Fila).Value ' en la col-C se tienen las fechas de los vencimientos miCita.Start = "11:00 am" & Format(Range("c" & Fila).Value, "mm/dd/yyyy") miCita.End = "11:15 am" & Format(Range("c" & Fila).Value, "mm/dd/yyyy") miCita.ReminderMinutesBeforeStart = 0 ' se deja en 0 para que avise en ese momento miCita.ReminderPlaySound = True miCita.Save Next miOutlook.Quit Set miCita = Nothing Set miOutlook = Nothing End Sub
Me marca un error en:
Dim miOutlook AsObject, miCalendario AsObject, miCita AsObject,
Y en realidad yo solo quiero para un calendario
Contrato Fechas
405033XXX 2012 2013 2014 2015
1 Respuesta
Con el siguiente código puedes almacenar una cita en outlook:
Dim OLNS As Object
Dim OLAppointment As Object
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 = Range("A1").Value 'Asunto
OLAppointment.Body = Range("B1").Value 'Cuerpo
OLAppointment.Start = Range("C1").Value 'inicio ej: 08/12/2012 17:00:00 p.m.
OLAppointment.Duration = Range("D1").Value 'duración ej para hora y media: 90
OLAppointment.Location = Range("E1").Value 'Ubicación
OLAppointment.ReminderMinutesBeforeStart = Range("F1").Value 'aviso
OLAppointment.Save 'para guardar la cita
'OLAppointment.display 'Para mostrar la cita
Set OLAppointment = Nothing
Set OLNS = Nothing
Set OLApp = Nothing
End If
End SubLa información de la cita la tienes que poner en las celdas A1 a F1 , en la macro va un pequeño ejemplo.
Prueba y me comentas
Saludos. Dam
hola muchas gracias una pregunta con esto puedo almacenar muchas citas en una tabla de Excel? O sólo una? Saludos y gracias
Solo funciona para una cita, la escribes en excel y con la macro te la crea en outlook, se tiene que modificar la macro para leer muchas citas de excel y que te cree todas en outlook.
Por favor podrías finalizar la pregunta y se deseas algo mas, con todo gusto te ayudo, pero deberás crear un pregunta por evento. Saludos. Dam
