** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Otros de Microsoft: Windows y Office > Otros Productos Microsoft
  Mensajes nuevos Mensajes nuevos RSS - exportar citas de calendario outlook 2010
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

exportar citas de calendario outlook 2010

 Responder Responder
Autor
Mensaje
azezino Ver desplegable
Habitual
Habitual
Avatar

Unido: 22/Enero/2007
Localización: España
Estado: Sin conexión
Puntos: 170
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita azezino Cita  ResponderRespuesta Enlace directo a este mensaje Tema: exportar citas de calendario outlook 2010
    Enviado: 12/Abril/2017 a las 13:03
buenas


posteo aquí ya que necesito sacar las citas de Outlook 2010 (un calendario compartido concreto) y el destino puede ser cualquier formato de tabla (Excel o Access)

he probado diferentes ejemplos y no me funcionan, parece código oriendato a partir de la versión 2013. 
el que más me ayudaría es el del enlace siguiente:

pero no consigo que funcione


alguien tiene experincia con este tipo de acciones?


Cuando el camino se pone duro, el duro se pone en camino.
Arriba
azezino Ver desplegable
Habitual
Habitual
Avatar

Unido: 22/Enero/2007
Localización: España
Estado: Sin conexión
Puntos: 170
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita azezino Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 12/Abril/2017 a las 13:16
quería añadir que en el hilo que pongo, la persona que hace la petición lo quiere para calendario Google pero yo para Exchange, que es en el camino que contesta el amable "Ken Puls".

lo máximo que he conseguido, al poner en la casilla mi dirección de correo, es que me capture una sola cita y quiero poder seleccionar un calendario compartido...
Cuando el camino se pone duro, el duro se pone en camino.
Arriba
azezino Ver desplegable
Habitual
Habitual
Avatar

Unido: 22/Enero/2007
Localización: España
Estado: Sin conexión
Puntos: 170
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita azezino Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 20/Abril/2017 a las 11:56
el siguiente código funciona.
hay que tener en cuenta que se deben añadir las referencias de outlook, que parece una obviedad, pero a veces pasa.

me encuentro que para el calendario de mi usuario va sin problemas, pero no consigo que funcione con los calendarios que comparten conmigo, que justamente es lo que realmente quiero.

dejo por aquí el código por si puede ayudar a alguien.

pd: en un caso de necesidad he pensado en enviar el excel que funciona con el calendario local y que me lo manden rellenado, pero preferiría poder hacerlo de forma autónoma sin molestar a nadie.

un saludo



Sub Botón1_Clic()
    Call GetCalData("01/06/2017", "28/06/2017")
End Sub


Private Function Quote(MyText)
 Quote = Chr(34) & MyText & Chr(34)
End Function


Private Sub GetCalData(StartDate As Date, Optional EndDate As Date)
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim myCalItems As Outlook.Items
    Dim ItemstoCheck As Outlook.Items
    Dim ThisAppt As Outlook.AppointmentItem
    Dim MyItem As Object
    Dim StringToCheck As String
    Dim MyBook As Excel.Workbook
    Dim rngStart As Excel.Range
    Dim i As Long
    Dim NextRow As Long

On Error Resume Next
  Set olApp = GetObject(, "Outlook.Application")
  If Err.Number <> 0 Then
    Set olApp = CreateObject("Outlook.Application")
  End If
On Error GoTo 0

If olApp Is Nothing Then
  MsgBox "Cannot start Outlook.", vbExclamation
  GoTo ExitProc
End If

Set olNS = olApp.GetNamespace("MAPI")
Dim myRecipient As Outlook.Recipient

Set myRecipient = olNS.CreateRecipient("usuarioExchange") 
myRecipient.Resolve
Dim calendarFolder As Outlook.Folder
Set calendarFolder = olNS.GetSharedDefaultFolder(myRecipient, olFolderCalendar)

Set myCalItems = calendarFolder.Items

myCalItems.Sort "Start", False
myCalItems.IncludeRecurrences = True

StringToCheck = "[Start] >= " & Quote(StartDate & " 12:00 AM") & " AND [End] <= " & Quote(EndDate & " 11:59 PM")
Debug.Print StringToCheck

Set ItemstoCheck = myCalItems.Restrict(StringToCheck)
Debug.Print ItemstoCheck.Count

If ItemstoCheck.Count > 0 Then
 
 If ItemstoCheck.Item(1) Is Nothing Then GoTo ExitProc
  Set MyBook = ThisWorkbook
  Set rngStart = ThisWorkbook.Sheets(1).Range("A1")
  With rngStart
    .Offset(0, 0).Value = "Convocant"
    .Offset(0, 1).Value = "Data inici"
    .Offset(0, 2).Value = "Final"
    .Offset(0, 3).Value = "Lloc"
 End With
 
  For Each MyItem In ItemstoCheck
    If MyItem.Class = olAppointment Then
     Set ThisAppt = MyItem
        NextRow = Range("A" & Rows.Count).End(xlUp).Row
        With rngStart
        .Offset(NextRow, 0).Value = ThisAppt.Organizer
        .Offset(NextRow, 1).Value = ThisAppt.Start
        .Offset(NextRow, 2).Value = ThisAppt.End
        .Offset(NextRow, 3).Value = ThisAppt.Location
        End With
   End If
  Next MyItem
  
Columns.AutoFit

 
Else
    MsgBox "There are no appointments or meetings during" & _
      "the time you specified. Exiting now.", vbCritical
End If

ExitProc:
Set myCalItems = Nothing
Set ItemstoCheck = Nothing
Set olNS = Nothing
Set olApp = Nothing
Set rngStart = Nothing
Set ThisAppt = Nothing
End Sub

Cuando el camino se pone duro, el duro se pone en camino.
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable