EXCELeINFO

Cómo extraer correos desde Outlook a Excel filtrando por fecha y descargar archivos adjuntos

by · 25 November, 2020

POST ORIGINAL: Cómo extraer correos desde Outlook a Excel filtrando por fecha y descargar archivos adjuntos

En este tutorial te enseñé cómo desarrollar una macro que nos permitía extraer información de los correos que tenemos en una cuenta configurada en Outlook de Office.

En este video tutorial vamos a retomar ese archivo y le vamos a hacer dos mejoras importantes: vamos a poder filtrar por fechas, además de que vamos a poder extraer los archivos adjuntos de los correos que cumplan con la fecha del filtro, y claro, que tengan adjuntos.

Ver Video Extraer correos de Outlook por fecha y descargar adjuntos

Suscríbete al canal de EXCELeINFO en YouTube para aprender más de Excel y macros.

Previamente

En el ejemplo anterior devolvíamos los siguientes campos de los correos: DESDE, DESTINATARIO, ASUNTO, FECHA Y HORA Y CUERPO DEL CORREO. Estos datos se volcaban sobre un rango en Excel.

Extraer información de los correos de Outlook a Excel

Figura 1. Extraer información de los correos de Outlook a Excel.

Filtrar por fecha

A la macro le vamos a añadir la manera de que podamos definir una fecha de inicio y una de finalización, en caso de que no necesiten extraer todos los correos, sino de un rango en específico, un año o mes. Hasta ahora las fechas están definidas de manera manual en el código, pero siéntete libre de capturar las fechas en celdas o incluso desde un Formulario.

Extraer archivos adjuntos de los correos de Outlook

Tenemos una carpeta nueva donde deseamos que todos los archivos adjuntos se guarden ahí. Al hacer el filtro por fecha, se devolverán todos lo mensajes y sólo de lo mensajes que tengan adjuntos, es que los vamos a descargar.

Descargar archivos adjuntos de Outlook de Office desde Excel usando VBA

Figura 2. Descargar archivos adjuntos de Outlook de Office desde Excel usando VBA.

Y como plus, en el rango donde ponemos la información de los correos, vamos a insertar una columna de ADJUNTOS para poner la cantidad de archivos adjuntos en cada correo, así como una columna NOMBRES para devolver los nombres de todos los archivos en cada correo.

Tabla de información de correos de una cuenta de Outlook

Figura 3. Tabla de información de correos de una cuenta de Outlook.

Código VBA de la macro

Option Explicit

'EXCELeINFO
'MVP Sergio Alejandro Campos
'http://www.exceleinfo.com
'https://www.youtube.com/user/sergioacamposh
'http://blogs.itpro.es/exceleinfo

Sub ExtraerCorreosDeOutlook()

Dim OutlookApp As Outlook.Application
Dim ONameSpace As Object
Dim MyFolder As Object
Dim OItem As Outlook.MailItem
Dim Fila As Integer
Dim FolderDescarga As String
Dim Adjuntos As Integer
Dim NombreArchivo1, NombreArchivo
Dim i As Integer
Dim Fecha1 As Date
Dim Fecha2 As Date

Set OutlookApp = New Outlook.Application
Set ONameSpace = OutlookApp.GetNamespace("MAPI")
Set MyFolder = ONameSpace.GetDefaultFolder(olFolderInbox)
'Set MyFolder = ONameSpace.Folders("correo@gmail.com").Folders("Carpeta")

FolderDescarga = ThisWorkbook.Path & "\Extract"

Range(Range("A2"), ActiveCell.SpecialCells(xlLastCell)).ClearContents

Fila = 2
Fecha1 = "01/01/2020"
Fecha2 = "31/12/2020"

For Each OItem In MyFolder.Items

    If Int(OItem.ReceivedTime) >= Fecha1 And Int(OItem.ReceivedTime) <= Fecha2 Then

        Adjuntos = 0
        NombreArchivo1 = ""
        
        If OItem.Attachments.Count > 0 Then
        
            For i = 1 To OItem.Attachments.Count
                NombreArchivo = OItem.Attachments.Item(i).Filename
                OItem.Attachments.Item(i).SaveAsFile FolderDescarga & "\" & NombreArchivo
                NombreArchivo1 = NombreArchivo & ", " & NombreArchivo1
                Adjuntos = Adjuntos + 1
            Next i
        End If
            Sheets("Hoja1").Cells(Fila, 1).Value = OItem.SenderEmailAddress
            Sheets("Hoja1").Cells(Fila, 2).Value = OItem.To
            Sheets("Hoja1").Cells(Fila, 3).Value = OItem.Subject
            Sheets("Hoja1").Cells(Fila, 4).Value = OItem.ReceivedTime
            Sheets("Hoja1").Cells(Fila, 5).Value = Adjuntos
            Sheets("Hoja1").Cells(Fila, 6).Value = NombreArchivo1
            Sheets("Hoja1").Cells(Fila, 7).Value = OItem.Body
    
        Fila = Fila + 1
        
    End If

Next OItem

Set OutlookApp = Nothing
Set ONameSpace = Nothing
Set MyFolder = Nothing

End Sub

Te puede interesar

Descarga el archivo de ejemplo

Extraer correos desde Outlook a Excel usando VBA y macros-2 – EXCELeINFO.xlsm

Si te gustó este tutorial por favor regístrate en nuestra Lista de correo y Suscríbete a nuestro canal de YouTube para que estés siempre enterado de lo nuevo que publicamos.

Tags:

You may also like...