Páginas

martes, 19 de enero de 2016

VBA OUTLOOK: Como guardar los adjuntos en una seleccion de correos

La clave es utilizar la propiedad "Selection" del Objeto explorer:


Sub guardarAdjuntos()

Dim mensaje As MailItem
Dim mensajes As Variant
Dim adjunto As Attachment
Dim carpeta As String

'escribo el nombre de la carpeta
carpeta = "D:\miCarpeta\"

'Va por cada elemento seleccionado
For Each element In Application.ActiveExplorer.Selection
   'verifica que el elemento sea un mensaje de correo
   If TypeName(element) = "MailItem" Then
        Set mensaje = element
        If mensaje.Attachments.Count > 0 Then 'si hay algun adjunto
            For Each adjunto In mensaje.Attachments 'explora cada adjunto en el mensaje
                adjunto.SaveAsFile (carpeta & adjunto.FileName)
            Next
        MsgBox "Adjuntos guardados: " + mensaje.Subject
        End If
   End If
Next
End Sub