Macro para sustituir “Cumpleaños “ por “C. “ en las citas de Outlook 2007

Una amiga me pidió que le echara una mano para sustituir todas las ocurrencias de “Cumpleaños “ por algo más corto en las citas de Outlook. Parece que no es configurable así que tendremos que ejecutar esta macro de vez en cuando.

El problema está en que cuando quieres ver toda la semana en las citas solo te aparece “Cumpleaños de…” y no sabes de quien es. El objetivo es ahorrar sitio en la pantalla con una abreviatura. He modificado el ejemplo que aparece en http://msdn.microsoft.com/en-us/library/dd490722(office.12).aspx eliminando los filtros de tiempo.

Con algunos pequeños cambios podemos usarlo para realizar sustituciones en cualquier carpeta y cualquier campo.

Sub FindAppts()
    Dim daStart, daEnd As Date
    Dim oCalendar As Outlook.Folder
    Dim oItems As Outlook.Items
    Dim oItemsInDateRange As Outlook.Items
    Dim oFinalItems As Outlook.Items
    Dim oAppt As Outlook.AppointmentItem
    Dim strRestriction As String
    Dim Modificados As Double
    Dim TextToSearch As String
    Dim TextToReplace As String
   
    TextToSearch = “Cumpleaños ”
    TextToReplaceWith = “C. ”
   
    ‘daStart = Format(Date, “mm/dd/yyyy hh:mm AMPM”)
    ‘daEnd = DateAdd(“d”, 30, daStart)
    ‘daEnd = Format(daEnd, “mm/dd/yyyy hh:mm AMPM”)
    ‘Debug.Print “Start:”, daStart
    ‘Debug.Print “End:”, daEnd
         
    ‘ Construct a filter for the next 30-day date range.
    ‘strRestriction = “[Start] >= ‘” & daStart _
    ‘& “‘ AND [End] <= ‘” & daEnd & “‘”
    ‘Debug.Print strRestriction
   
    Set oCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
    Set oItems = oCalendar.Items
   
    ‘ To include recurring appointments, sort by using the Start property.
    oItems.IncludeRecurrences = True
    oItems.Sort “[Start]”
   
    ‘ Restrict the Items collection for the 30-day date range.
    ‘Set oItemsInDateRange = oItems.Restrict(strRestriction)
    Set oItemsInDateRange = oItems ‘ by Jacinto
   
    ‘ Construct a filter for subjects that contain ”team”.
    Const PropTag  As String = “
http://schemas.microsoft.com/mapi/proptag/”

    strRestriction = “@SQL=” & Chr(34) & PropTag _
        & “0x0037001E” & Chr(34) & ” like ‘%” & TextToSearch & “%'”
   
    ‘ Restrict the last set of filtered items for the subject.
    Set oFinalItems = oItemsInDateRange.Restrict(strRestriction)    Modificados = 0
   
    ‘ Sort and print the final results.
    oFinalItems.Sort “[Start]”
    For Each oAppt In oFinalItems
        Debug.Print “Found: “, oAppt.Subject, oAppt.Start
        oAppt.Subject = Replace(oAppt.Subject, TextToSearch, TextToReplaceWith)
        oAppt.Save
        Modificados = Modificados + 1
        Debug.Print “Replaced with: “, oAppt.Subject, oAppt.Start
    Next
    Debug.Print “Modificados: “, Modificados
       
End Sub
 
 

 

 

Anuncios
Esta entrada fue publicada en Desarrollo. Guarda el enlace permanente.

Responder

Introduce tus datos o haz clic en un icono para iniciar sesión:

Logo de WordPress.com

Estás comentando usando tu cuenta de WordPress.com. Cerrar sesión / Cambiar )

Imagen de Twitter

Estás comentando usando tu cuenta de Twitter. Cerrar sesión / Cambiar )

Foto de Facebook

Estás comentando usando tu cuenta de Facebook. Cerrar sesión / Cambiar )

Google+ photo

Estás comentando usando tu cuenta de Google+. Cerrar sesión / Cambiar )

Conectando a %s