Imprimir página | Cerrar ventana

Outlook copiar de un calendario a otro con VBA ?

Impreso de: Foro de Access y VBA
Categoría: Otros de Microsoft: Windows y Office
Nombre del foro: Otros Productos Microsoft
Descripción del foro: PowerPoint, Navision, Visio, FrontPage, InfoPath etc
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=50736
Fecha de impresión: 31/Octubre/2020 a las 08:59


Tema: Outlook copiar de un calendario a otro con VBA ?
Publicado por: pedrito
Asunto: Outlook copiar de un calendario a otro con VBA ?
Fecha de publicación: 11/Septiembre/2008 a las 19:25
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


-------------
Este access es que me desespera... pero cada día menos...
...Y solo me faltaba .NET
Este si que va acabar conmigo.



Respuestas:
Publicado por: Jordi-Albert
Fecha de publicación: 11/Septiembre/2008 a las 19:33
El problema en este caso no es acceder a la informacion de los otros calendarios, sino a que el programa de traspaso de la PDA los reconozca.

todos mis intentos de hacer algo parecido han supuesto muchas horas, para al final llegar a la conclusion que es mejor agruparlo todo o bien indicar a la PDA los correspondientes caminos (lease calendarios) si es que te lo permite


Publicado por: Jordi-Albert
Fecha de publicación: 11/Septiembre/2008 a las 19:38
Publicado originalmente por pedrito 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)


Publicado por: pedrito
Fecha de publicación: 11/Septiembre/2008 a las 19:52
Tengo bastante experiencia con VBA en Access.
Supongo que me costara adaptarme un poco a sus propias instrucciones y modificadores.
Voy a echar un ojo y os cuento....


-------------
Este access es que me desespera... pero cada día menos...
...Y solo me faltaba .NET
Este si que va acabar conmigo.


Publicado por: pedrito
Fecha de publicación: 18/Septiembre/2008 a las 20:03
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



-------------
Este access es que me desespera... pero cada día menos...
...Y solo me faltaba .NET
Este si que va acabar conmigo.


Publicado por: xavi
Fecha de publicación: 18/Septiembre/2008 a las 21:14
Vaya por delante que es la primera vez que voy a decir mi opinion sobre un código de Outlook, pero allá va.
 
....
For Each olItem In myFolder.Items
  If olItem.Categories Like "bit*" Then
    Debug.Print olItem.Categories & " " & olItem.Subject
  End If
Next
 
Pero la verdad es que no entendi que pretendes exactamente en esta linea:
 
Debug.Print olItem.Categories & "  " & olItem.Subject Like olItem.Categories = "bit*"
(bueno, la parte del Debug.Print si la entendi)


-------------
Xavi, un minyó de Terrassa

http://www.llodax.com" rel="nofollow - Mi web


Publicado por: pedrito
Fecha de publicación: 19/Septiembre/2008 a las 07:53
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 Stern%20Smile.
Tambien he probado con Select Case (por sia) y tampoco...Ouch

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

Alguna sugerencia más ?



-------------
Este access es que me desespera... pero cada día menos...
...Y solo me faltaba .NET
Este si que va acabar conmigo.


Publicado por: Jordi-Albert
Fecha de publicación: 19/Septiembre/2008 a las 10:01
con respecto a recorrer las carpetas casi lo tienes...

Publicado originalmente por pedrito pedrito escribió:



  Dim myvol As Outlook.Application
  .....
  Set myol = CreateObject("Outlook.Application")
  Set myNameSpace = myol.GetNamespace("MAPI")


Primero de todo (supongo que es un error de tecleado) tienes un error en la definicion de la aplicacion (falta una v)

Publicado originalmente por pedrito pedrito escribió:



 Set myFolder = myNameSpace.GetDefaultFolder(olFolderCalendar)



Estás seleccionando SOLO la carpeta por defecto de los calendarios.

Deberías añadir un bucle previo para recorrer todos los "folders" y posteriormente mirar el tipo de informacion que hay en ellos.

for each oneFolder in myNameSpace.folders

con esto supongo que puedes deducir el resto....

Nota: felicidades, veo que has consiguido el 90% del trabajo sin demasiada ayuda por nuestra parte...
         Si te encallas, ya nos haras saber el problema



Publicado por: Jordi-Albert
Fecha de publicación: 19/Septiembre/2008 a las 10:31
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)


Publicado por: pedrito
Fecha de publicación: 19/Septiembre/2008 a las 18:55
Publicado originalmente por Jordi-Albert Jordi-Albert escribió:

con respecto a recorrer las carpetas casi lo tienes...

Publicado originalmente por pedrito pedrito escribió:



  Dim myvol As Outlook.Application
  .....
  Set myol = CreateObject("Outlook.Application")
  Set myNameSpace = myol.GetNamespace("MAPI")


Primero de todo (supongo que es un error de tecleado) tienes un error en la definicion de la aplicacion (falta una v)

Publicado originalmente por pedrito pedrito escribió:



 Set myFolder = myNameSpace.GetDefaultFolder(olFolderCalendar)



Estás seleccionando SOLO la carpeta por defecto de los calendarios.

Deberías añadir un bucle previo para recorrer todos los "folders" y posteriormente mirar el tipo de informacion que hay en ellos.

for each oneFolder in myNameSpace.folders

con esto supongo que puedes deducir el resto....

Nota: felicidades, veo que has consiguido el 90% del trabajo sin demasiada ayuda por nuestra parte...
         Si te encallas, ya nos haras saber el problema



Pues o estoy "espesito" o no me termino de aclarar.
No consigo minimamente listar los nombres de calendarios que tengo, contra ni más acceder a recorrerlos.
Estoy haciendo miles de pruebas con esto (y otros que leo en la ayuda):

Set myFolder = myNamespace.Folders

Me da el error de que no coiniciden los tipos...Ouch

Algo no termino de entender...

Como listo los nombres de calendarios que tengo, para luego, con este "medio" módulo (que estamos creando entre todos), recorremos las citas, al igual que hace ahora con el calendario principal...???

Vaya si me lo está poniendo crudo el Outlook. Y me quejaba yo de Access....Sleepy




-------------
Este access es que me desespera... pero cada día menos...
...Y solo me faltaba .NET
Este si que va acabar conmigo.


Publicado por: Jordi-Albert
Fecha de publicación: 20/Septiembre/2008 a las 20:24
tienes que definir MyFolder
una vez lo tengas biend definido podrás ver las carpetas (ficheros) que etngas abiertas....
 
 


Publicado por: pedrito
Fecha de publicación: 21/Septiembre/2008 a las 13:46
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")
  Set myFolder = myNameSpace.Folders
 
For Each oappItem In myFolder.Items
  If oappItem.Categories Like "Guar*" Then
    Debug.Print olItem.Categories & " - " & oappItem.Subject
  End If
  Next oappItem


End Sub

Supongo que aquí esta el lío, pero no se como "definirla".
Se supone que ya está como "Folders" de "myNameSpace" no?

Una manilla por fa...
Gracias
 

-------------
Este access es que me desespera... pero cada día menos...
...Y solo me faltaba .NET
Este si que va acabar conmigo.


Publicado por: Jordi-Albert
Fecha de publicación: 21/Septiembre/2008 a las 15:41

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

 

Publicado originalmente por pedrito 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

 
 
Nota: hace ya tiempo  conteste un hilo sobre este tema... busca en el foro off-line (link en la parte superior izquierda de esta misma hoja) con mi nombre y con la palabra Outlook..
 
No se cuanto tiempo dispondre esta semana... (hasta el jueves que no vuelva a casa)


Publicado por: Jordi-Albert
Fecha de publicación: 22/Septiembre/2008 a las 23:53
rapidamente he encontrado algo que te puede ayudar...
 
Public Sub ReadAdr(pi_option As String)
Dim olookApplication    As Outlook.Application
Dim olookNameSpace      As Outlook.NameSpace
Dim olookMAPIFolder     As Outlook.MAPIFolder
Dim olookFolder         As Outlook.MAPIFolder
Const olMailItem = 0
Const olAppointmentItem = 1
Const olContactItem = 2
Const olTaskItem = 3
Const olJournalItem = 4
Const olNoteItem = 5
Const olPostItem = 6
 
Set olookApplication = CreateObject("Outlook.Application")
Set olookNameSpace = olookApplication.GetNamespace("MAPI")
olookNameSpace.Logon
For Each olookMAPIFolder In olookNameSpace.Folders
   If olookMAPIFolder.Folders.Count > 1 Then
      For Each olookFolder In olookMAPIFolder.Folders
         If olookFolder.DefaultItemType = olContactItem Then
             '____tratar
         End If
      Next
   End If
Next
 
nota: cambia el tipo de datos según te convenga (según los tipos definidos en la misma funcion)


Publicado por: pedrito
Fecha de publicación: 25/Septiembre/2008 a las 13:05
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...).Ermm

(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....Confused.

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


-------------
Este access es que me desespera... pero cada día menos...
...Y solo me faltaba .NET
Este si que va acabar conmigo.


Publicado por: Jordi-Albert
Fecha de publicación: 25/Septiembre/2008 a las 21:49

- primero de todo: felicidades.... veo que has conseguido (casi) lo que te comentaba...

desgraciadamente continuo muy liado el resto de la semana (esta y la entrante) por lo que no me voy a poner a hacer el código, pero creo que te puede seguir ayudando
 
Antes de nada prefiero empezar por criticar el código, y despues continuamos con ello.
 
1- pones If onefolder Like "Personal" Then  pero onefolder es un objeto, por lo que estás utilizando el atributo por defecto.
   esto es peligroso y además no se por que lo haces... (y que es "personal", no debería ser un tipo de carpeta de las que has visto definidas en mi código????)
 
2- en el segundo bucle utilizar el mismo contador para los dos arrays, por lo que estás dejando cada uno de ellos medio vacio... y para hacer un seguimiento la cosa se complica mucho, pues existen elementos del array vacios.
 
3- mi propuesta era crear un array de la carpeta principal y, en vez de crear otros arrays, procesar cada uno de los elementos de las otras carpetas comparandolas con los elementos de la primera (los cuales si que estan en el array)
dependiendo de la cantidad de elementos y de lo frecuente que quieras actualizar, quizás puedes recorrer la carpeta principal cada vez...
 
4- el comparar arrays no es complicado
   en tu caso deberias hacer (es el peor algoritmo posible)
    for intX = LBound(array1) to UBound(array1)
        for intY = LBound(array2) to UBound(array2)
              if array1(intX) = array2(intY) then
                   '____procesar
              end if
         next
    next
 
5- el exportar a excel e importar te va a dar otros problemas añadidos. Yo lo dejaría como última opción
 
nota: para borrar la ventana de inmediato te situas con el cursor, seleccionas todo (Ctrl+A o Ctrl-E dependiendo de tu teclado) y aprietas el boton de suprimir
 



Imprimir página | Cerrar ventana