VBScript – Guardar Archivos Adjuntos de Correos .MSG Ya Guardados en el Disco Duro

Ya que es un tema común requerir, extraer o guardar archivos adjuntos de correos .MSG guardados en el disco duro sin necesidad de abrir cada uno de ellos, esto es posible por medio de algo de programación VBScript, el cual a continuación les anexamos el código.

También puedes extraer o guardar los archivos automáticamente al momento de recibir los correos con archivos .MSG Ver Articulo: VBScript – Guardar Archivos Adjuntos de Correos .MSG Automaticamente (Guardar adjuntos de correos adjuntos).

Código

Sub SaveMSGAttachments()
Dim olItem As MailItem
Dim SH As Object
Dim msgFolder
Dim saveFolder
Dim strFilesFldr As String
Dim strSaveFldr As String
Dim objAtt As Outlook.Attachment
Dim strFilename As String

On Error GoTo Cleanup
Set SH = CreateObject("SHell.Application")

Set msgFolder = SH.BrowseForFolder(0, "Selecciona el Folder que Contiene los .msg", &H400)
If msgFolder Is Nothing Then Exit Sub
strFilesFldr = msgFolder.Items.Item.Path & "\"

Set saveFolder = SH.BrowseForFolder(0, "Selecciona el Folder para Guardar los Adjuntos", &H400)
If saveFolder Is Nothing Then Exit Sub
strSaveFldr = saveFolder.Items.Item.Path & "\"

strFilename = Dir$(strFilesFldr & "*.msg")


While Len(strFilename) <> 0
    Set olItem = Application.CreateItemFromTemplate(strFilesFldr & strFilename)
    If olItem.Attachments.Count > 0 Then
        For Each objAtt In olItem.Attachments
            objAtt.SaveAsFile strSaveFldr & Format(Now, "yyyymmdd-HHMMSS") & Chr(32) & objAtt.FileName
        Next objAtt
    End If
    olItem.Delete
    strFilename = Dir$()
Wend
Cleanup:
Set msgFolder = Nothing
Set saveFolder = Nothing
Set SH = Nothing
Set objAtt = Nothing
Set olItem = Nothing
End Sub

Instrucciones de Uso

1.- Creamos el modulo en VBScript (Ver: Como utilizar el Editor VBA en Office Outlook).

2.- Una vez creado sin cerrar la ventana del Editor VBA presionamos la tecla F5 o damos clic en Run Sub (Ejecutar Fun) Ejecutar - Guardar Archivos Adjuntos de Correos

3.- Al momento de ejecutarse nos aparecerá la primer ventana de búsqueda donde seleccionamos la carpeta donde tenemos los correos (.msg).Guardados - Guardar Archivos Adjuntos de Correos

Leer:  Remover contraseña de Proyecto VBA de Excel

4.- Después nos aparecerá una segunda ventana donde indicaremos donde deseamos guardar los adjuntos.Donde - Guardar Archivos Adjuntos de Correos

5.- Dependiendo de la cantidad de correos este puede tardar unos segundos o minutos y listo revisamos la carpeta destino y encontraremos los adjuntos.

6.-Si hemos cerrado y deseamos ejecutar el basta con presionar las teclas ALT+F11 para abrir el Editor VBA para poder ejecutar nuevamente el Script.

Fernando O.

Fernando O.

Soy analista de sistemas actualmente trabajo en una empresa con mas de 200 empleados que utilizan equipo de computo al cual se les da soporte en el departamento.
Uno de mis pasatiempos fuera de la empresa es escribir artículos para PortalMasTips donde documento los problemas, inquietudes y detalles interesantes que se presentan.
Fernando O.

Latest posts by Fernando O. (see all)

2
Deja una respuesta

avatar
 
Archivos de fotos e imágenes
 
 
 
Archivos de audio y video
 
 
 
Otros tipos de archivos
 
 
 
1 Hilos de comentarios
1 Respuestas de hilo
0 Seguidores
 
Comentario más reaccionado
Hilo de comentarios más caliente
2 Autores de comentarios
Portal+TipsLuis Ayala Autores de comentarios recientes

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.

  Suscribir  
el más nuevo más antiguo más votado
Notificar de
Luis Ayala
Guest
Luis Ayala

no jala la macro , me indica “User-defined type not definied”

y marca la segunda linea como error, y en amarillo la primera linea, que sera?

Compartir
Twittear
Pin
Más en Outlook VBScript
VBScript – Guardar Archivos Adjuntos de Correos .MSG Automaticamente (Guardar adjuntos de correos adjuntos)

VBScript – Respaldar o Copiar los Correos de Outlook a una Carpeta en el Disco Duro

Como utilizar el Editor VBA en Office (Utilizar Macros VBScript)

Cerrar