Outlook copiar de un calendario a otro con VBA ?

Un problemilla un poco mas agudo.
Tengo varios calendarios en outlook para diferentes cosas cada uno.
En uno llevo cosas de la empresa, en otro cosas personales, en otro mis trabajos fuera de empresa, etc...
El problema es que al sincronizar con el PPC (que usa el Pocket Informant), solo sincroniza el calendario principal por defecto del outlook.
No permite varios calendarios al igual que dicho Outlook.
Si quiero llevar todos los calendarios en la PDA necesito copiar todas las notas de los diferentes calendarios al calendario principal.

Estoy buscando la forma de hacer un Copy/Paste o similar con VBA para automatizar dicha tarea de copiar todo lo anotado en los calendarios al principal manteniendo su categoria y por supuesto fecha/hora.

Si alguien me puede orientar un poquillo con el código se lo agradezco...

Gracias

pedrito escribió: Estoy buscando la forma de hacer un Copy/Paste o similar con VBA para automatizar dicha tarea de copiar todo lo anotado en los calendarios al principal manteniendo su categoria y por supuesto fecha/hora.

¿perdon... entiendo que deseas copiar TODOS los calendarios en uno solo?

no es muy complicado.. tengo algunos hilos en el foro - (mirate el for off-line porque ya deben estar borrados del on-line) que recorren el outlook para mirar cosas...

quizás te sirva como orientacion (pero si no tienes experiencia quizás es mejor hacerlo a mano)

Bueno...
Indagando y buscando he conseguido recorrer todas las citas del calendario con el código de abajo que he encontrado por un post de por aquí.
Pero me falta recorrer los calendarios personales, aparte de este que es el principal.

Mi necesidad es.
Recorrer todas las citas de todos los calendarios (principal y personales)
Filtrar las citas por según qué categorías se necesitan en ese momento.
Tras esto, comparar uno de los calendarios cualquiera con el principal y si interesa (según variables o bloques de comparación) agregar las citas que falten al calendario principal. (ya que los que se actualizan son los personales)

Y tambien filtrar (en este caso por categorías).
He probado con un operador Like y varias maneras más y no me filtra.
Dejo aquí el código para que le echeis un vistazo.

Gracias.

  Dim myvol As Outlook.Application
  'Sistema de mensajeria
  Dim myNameSpace As Outlook.NameSpace
  'Folder y/o carpeta
  Dim myFolder As Outlook.MAPIFolder
  'Item, las citas son tipo --> AppointmentItem
  Dim olItem As Outlook.AppointmentItem
   
  'Se instancia la aplicacion Outlook
  Set myol = CreateObject("Outlook.Application")
  'Se instancia el sistema de mensajeria
  Set myNameSpace = myol.GetNamespace("MAPI")
  'Se instancia la carpeta que contiene las entradas
  Set myFolder = myNameSpace.GetDefaultFolder(olFolderCalendar)
  'Se recorre una a una cada cita
  For Each olItem In myFolder.Items
    Debug.Print olItem.Categories & "  " & olItem.Subject Like olItem.Categories = "bit*"
  Next olItem

Esta línea es para las pruebas. Simplemente para que liste la categoria y el "subject" o "texto de la cita" propiamente dicho que empiece por bit*.

He probado tu ejemplo, aunque creo que ya lo probé así y no filtra .
Tambien he probado con Select Case (por sia) y tampoco...

Parece extraño porque sin el filtro sí que lista todo bien....

Alguna sugerencia más ?

Con respecto a comparar y actualizar te aconsejo que hagas dos bucles.

Uno de ellos (que es el que tienes) para la carpeta por defecto.

Posiblemente te interesa leer los mensajes y guardar la informacion a comparar en un array, y de esta manera poder encontrar la info sin tener que recorrer toda la carpeta cada vez.

El otro es el bucle que yo te apuntaba en mi mensaje anterior...

creo que tienes suficiente experiencia como para no tener que detallar todos los pasos (que por otra parte dependen de lo que desees hacer)

tienes que definir MyFolder una vez lo tengas biend definido podrás ver las carpetas (ficheros) que etngas abiertas....

Disculpame que en esta ocasion no te esté prestando suficiente atencion, pues estoy de viaje con la empresa...

 

pedrito escribió: Public Sub xx()   Dim myNameSpace As Outlook.NameSpace   Dim myFolder As Outlook.MAPIFolder   Dim oappItem As Outlook.AppointmentItem        Set myol = CreateObject("Outlook.Application")   Set myNameSpace = myol.GetNamespace("MAPI") '___con esto recorreras las carpetas    For each  myFolder in myNameSpace.Folders '____    el mismo procedimiento que estabas haciendo con el default foder debes hacerlo para cada carpeta '_____ es decir, sustituye el default folder (que solo trata la carpeta por defecto) por este for each que lee todas las carpetas. el resto queda igual      next End Sub

Bueno. Volvemos a la carga. He aquí por donde llevo el trabajillo.
Ya tengo todos los calendarios, cargados en arrays diferentes.
Dudas que me surgen a partir de aquí:

(Una curiosa): Hay algún comando que borre la ventana inmediato tipo "cls" ?

(1) No me ha surgido comparar matrices, luego no se como hacerlo, y tendría que estudiar la forma así que acepto sugerencias si alguien ya lo ha hecho.

(2) No veo complicado (cuando aprenda a comparar las matrices) el añadir una cita al calendario correspondiente que no la tenga, ya que simplemente con la categoria de cada uno y el "count" de las citas, cantaría enseguida un descuadre, pero lo veo bastante complicado si en lugar de añadir una cita, se modificase alguna existente en alguno de ellos. A ver como se detecta eso....(a pensar...).

(3) Tal vez sea mas fácil exportar todo esto a Excel o Access, hacer las comparaciones, agregar y quitar citas, y devolverlo a Outlook ya tratado...

En fin, que creo que esto se está complicando mas de lo que yo creía y me estoy metiendo en un "cenagal" que a ver como salgo.....

Necesito sugerencias o ideas de vuestra experiencia maestros.....



He aquí el módulo que llevo construido de momento:


Public Type strCita
    Comienzo As String
    Fin As String
    Categoria As String
    Cita As String
    Notas As String
End Type

Public ArrayCalendarioPrincipal() As strCita
Public SubCalendario_1() As strCita
Public SubCalendario_2() As strCita

Public Sub x1()

Dim ArrayCounter As Long
Dim myolApp As New Outlook.Application
Dim myNamespace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim oappItem As Outlook.AppointmentItem
 
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myFolder = myNamespace.GetDefaultFolder(olFolderCalendar)
ReDim ArrayCalendarioPrincipal(myFolder.Items.Count)                 'Redimensionamos el Array.
ReDim SubCalendario_1(myFolder.Items.Count)                               'Redimensionamos el Array1.
ReDim SubCalendario_2(myFolder.Items.Count)                               'Redimensionamos el Array2

'Accedemos al calendario principal, recorremos y cargamos el Array con todas sus citas:

Debug.Print myFolder & "  " & myFolder.Items.Count & " Anotaciones:"
    For Each oappItem In myFolder.Items
            ArrayCounter = ArrayCounter + 1
            ArrayCalendarioPrincipal(ArrayCounter).Comienzo = oappItem.Start
            ArrayCalendarioPrincipal(ArrayCounter).Fin = oappItem.End
            ArrayCalendarioPrincipal(ArrayCounter).Categoria = oappItem.Categories
            ArrayCalendarioPrincipal(ArrayCounter).Cita = oappItem
            ArrayCalendarioPrincipal(ArrayCounter).Notas = oappItem.Body
            Debug.Print ArrayCalendarioPrincipal(ArrayCounter).Comienzo & "   " & _
                                 ArrayCalendarioPrincipal(ArrayCounter).Fin & "   " & _
                                 ArrayCalendarioPrincipal(ArrayCounter).Categoria & "   " & _
                                 ArrayCalendarioPrincipal(ArrayCounter).Cita & "   " & _
                                 ArrayCalendarioPrincipal(ArrayCounter).Notas
    Next
ArrayCounter = 0                                                                            'Reinicializamos para el siguiente calendario.

'Accedemos al calendario siguiente, recorremos y cargamos el Array con todas sus citas:

For Each onefolder In myFolder.Folders
    Debug.Print onefolder & "  " & onefolder.Items.Count & " Anotaciones:"
        For Each oappItem In onefolder.Items
            If onefolder Like "Personal" Then                                   'Filtrado para separar los Arrays
                ArrayCounter = ArrayCounter + 1
                SubCalendario_1(ArrayCounter).Comienzo = oappItem.Start
                SubCalendario_1(ArrayCounter).Fin = oappItem.End
                SubCalendario_1(ArrayCounter).Categoria = oappItem.Categories
                SubCalendario_1(ArrayCounter).Cita = oappItem
                SubCalendario_1(ArrayCounter).Notas = oappItem.Body
                Debug.Print SubCalendario_1(ArrayCounter).Comienzo & "   " & _
                                     SubCalendario_1(ArrayCounter).Fin & "   " & _
                                     SubCalendario_1(ArrayCounter).Categoria & "   " & _
                                     SubCalendario_1(ArrayCounter).Cita & "   " & _
                                     SubCalendario_1(ArrayCounter).Notas
            Else
                ArrayCounter = ArrayCounter + 1
                SubCalendario_2(ArrayCounter).Comienzo = oappItem.Start
                SubCalendario_2(ArrayCounter).Fin = oappItem.End
                SubCalendario_2(ArrayCounter).Categoria = oappItem.Categories
                SubCalendario_2(ArrayCounter).Cita = oappItem
                SubCalendario_2(ArrayCounter).Notas = oappItem.Body
                Debug.Print SubCalendario_2(ArrayCounter).Comienzo & "   " & _
                                     SubCalendario_2(ArrayCounter).Fin & "   " & _
                                     SubCalendario_2(ArrayCounter).Categoria & "   " & _
                                     SubCalendario_2(ArrayCounter).Cita & "   " & _
                                     SubCalendario_2(ArrayCounter).Notas
            End If
        Next
ArrayCounter = 0                                                                            'Reinicializamos y salimos.
Next

End Sub