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

7 comentarios:

  1. Gracias por tu respuesta a mi consulta anterior.
    Este código me sirvió, solo tuve que corregir el nombre de la variable "mensajes" por "element", pero solo fue un detalle.

    El único "problema" que le veo a este código, es que si por ejemplo, selecciono 20 correos, recibo 20 MsgBox y se debe aceptar cada uno para que se descarguen los adjuntos del siguiente correo de la cola seleccionada. (espero se haya entendido)

    Gracias nuevamente por tu tiempo!

    ResponderEliminar
    Respuestas
    1. Que bueno que te haya servido! si no deseas ver las notificaciones, elimina esta línea: MsgBox "Adjuntos guardados: " + mensaje.Subject

      Eliminar
  2. Hola, esta bárbaro el código el problema que tengo es que tengo varios mails con el mismo nombre en el adjunto como puedo hacer para que no se sobrescriba

    Muachas Gracias

    ResponderEliminar
    Respuestas
    1. Podrías crear un contador y agregarlo al nombre de archivo, como por ejemplo: carpeta & n & adjunto.filename

      Eliminar
  3. Muy bueno el código pero tengo un inconveniente cuando tengo varios adjuntos con el mismo nombre como se puede hacer para que no sobrescriba los adjuntos guardado

    Muchas Gracias

    ResponderEliminar
  4. El codigo que utilizo crea una carpeta con la fecha es el siguiente

    Sub guardar()
    Dim adjunto As Attachment
    Dim seleccion As Outlook.MailItem
    Dim i As Integer

    'escribo el nombre de la carpeta
    Dim fs, f
    nombrecarpeta = Format(Date, "dd-mm-yy")
    verificarcarpeta = "D:Proximos\" & nombrecarpeta
    If Dir(verificarcarpeta, vbDirectory) = "" Then
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.CreateFolder("D:Proximos\" & nombrecarpeta)
    carpeta = f
    Else
    carpeta = "D:\" & nombrecarpeta
    End If

    'primero verifica si la ventana activa es del tipo inspector
    For Each seleccion In Application.ActiveExplorer.Selection
    For Each adjunto In seleccion.Attachments 'explora cada adjunto en el mensaje
    NombreArchivo = carpeta & "\" & adjunto.FileName
    adjunto.SaveAsFile NombreArchivo
    i = i + 1
    Next adjunto
    Next seleccion
    MsgBox "Listo, archivos guardados"
    End Sub

    Donde deberia insertar lo que me decis

    ResponderEliminar