VBScript – Exporta a Excel Eventos y Reuniones del calendario de Outlook

Algunas veces puede no ser tan amigable el calendario de Outlook para revisar las Tareas o Eventos y Reuniones que tenemos asignados o también puede ser que deseemos manejar las Tareas muy antiguas en un Excel y asi poder depurar el calendario de trabajo de Outlook; sea cual sea el caso te muestro como Exportar rápidamente los eventos y reuniones del calendario de Outlook a Excel.

Instrucciones de Uso del VBScript

1.- Abrir el editor de Visual Basic (ALT+F11).

2.- Insertar un modulo nuevo (Insert > Module).

3.- Copiar el código VBScript.

4.- Modificar la linea 19 con la ruta existente para guardar los Excel.

5.- Opcional – Agregar botón de acceso rápido para ejecutar VBScript en Outlook

No es necesario realizar modificación alguna al menos que se indique en la variante de cada código.

Para mas información de configuración ver:

• Como utilizar el Editor VBA en Office (Utilizar Macros VBScript) 
• Outlook – Crear y configurar reglas
• Outlook – Opción ejecutar un script (run a script) no aparece en las reglas

VBScript para Exportar Tareas de Outlook a Excel.

El siguiente script nos ayuda a automatizar la exportación de las Tareas del calendario de Outlook a Excel de un periodo especifico, este no se debe utilizar para Exportar e Importar a otro calendario de Outlook ya que no esta en el formato requerido.

Al ejecutar el script obtendremos un Excel el cual se guarda automáticamente con el nombre Tareas de Fecha Inicio a Fecha Fin en el siguiente formato tendremos dos Hojas de trabajo una de Tareas o Eventos y otra de Reuniones.

Sub ExportTasksAppointmentsinSpecificDateRange()
    Dim objTasks, objRestrictTasks As Outlook.Items
    Dim objAppointments, objRestrictAppointments As Outlook.Items
    Dim objItem As Object
    Dim strFilter As String
    Dim strStartDate, strEndDate As String
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim xlSheet1, xlSheet2 As Excel.Worksheet
    Dim nRow As Integer
    Dim strFilePath As String
    Dim strMainFolder As String
    Dim strFileName As String
    
    strStartDate = InputBox("Fecha de inicio a Exportar (formato: yyyy/mm/dd)")
    strEndDate = InputBox("Fecha de fin a Exportar (formato: yyyy/mm/dd)")
    
    'Save File Folder
    strMainFolder = "C:1-Tests"
    'Name of File
    strFileName = "Tareas de " & Format(strStartDate, "yyyy-mm-dd") & " a " & Format(strEndDate, "yyyy-mm-dd") & ".xlsx"
 
 
    'Get the tasks in the specific date range
    Set objTasks = Application.Session.GetDefaultFolder(olFolderTasks).Items
    strFilter = "[StartDate] >= " & Chr(34) & strStartDate & Chr(34) & " AND [DueDate] <= " & Chr(34) & strEndDate & Chr(34) Set objRestrictTasks = objTasks.Restrict(strFilter) 'Get the appointments in the specific date range Set objAppointments = Application.Session.GetDefaultFolder(olFolderCalendar).Items strFilter = "[Start] >= " & Chr(34) & strStartDate & " 00:00 AM" & Chr(34) & " AND [End] <= " & Chr(34) & strEndDate & " 11:59 PM" & Chr(34)
    Set objRestrictAppointments = objAppointments.Restrict(strFilter)
 
    Set xlApp = CreateObject("Excel.Application")
    Set xlWB = xlApp.Workbooks.Add
    'Get Active Sheet
    xlSheetName = xlApp.ActiveSheet.Name
    Set xlSheet1 = xlWB.Worksheets(xlSheetName)
    
    'Add Titles
    With xlSheet1
         .Cells(1, 1) = "Asunto de Tarea"
         .Cells(1, 2) = "Inicio de Tarea"
         .Cells(1, 3) = "Fecha de Fin"
         .Cells(1, 4) = "Duracion"
    End With
 
    nRow = 2
    
    'Add Task to Excel
    For Each objItem In objRestrictTasks
        With xlSheet1
             .Name = "Tareas"
             .Cells(nRow, 1) = objItem.Subject
             .Cells(nRow, 2) = objItem.StartDate
             .Cells(nRow, 3) = objItem.DueDate
             .Cells(nRow, 4) = objItem.ActualWork
        End With
        nRow = nRow + 1
    Next
 
    xlSheet1.Columns("A:D").AutoFit
    
    'Add new Sheet
    Set xlSheet2 = xlWB.Sheets.Add
    xlSheetName = xlApp.ActiveSheet.Name
    Set xlSheet2 = xlWB.Worksheets(xlSheetName)
    'Add Titles
    With xlSheet2
         .Name = "Reuniones"
         .Cells(1, 1) = "Asunto de Tarea"
         .Cells(1, 2) = "Inicio de Tareae"
         .Cells(1, 3) = "Fecha de Fine"
         .Cells(1, 4) = "Duracion"
         .Cells(1, 5) = "Lugar"
    End With
 
    nRow = 2
    'Add Appointmens to Excel
    For Each objItem In objRestrictAppointments
        With xlSheet2
             .Cells(nRow, 1) = objItem.Subject
             .Cells(nRow, 2) = objItem.Start
             .Cells(nRow, 3) = objItem.End
             .Cells(nRow, 4) = objItem.Duration
             .Cells(nRow, 5) = objItem.Location
        End With
        nRow = nRow + 1
    Next
 
    xlSheet2.Columns("A:E").AutoFit

    'Save the excel workbook
    strFilePath = strMainFolder & strFileName
    xlWB.Close True, strFilePath
 
    'Notify you of the export complete
    MsgBox ("Proceso finalizado!")
End Sub