VBScript – Guardar Todos los Correos de la Carpeta Seleccionada a TXT Outlook

El siguiente script es una modificación del script publicado en el articulo Guardar Cuerpo de Correo Entrante en Archivo de Texto (TXT) Outlook, esta modificación al script es: todos los correos de la carpeta seleccionada (Ventana) lo guarda en un archivo TXT y lo nombra con la fecha que se recibe y subject (Asunto).

Instrucciones de Uso 

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

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

3.- Copiar el código VBScript.

4.- En la linea 10 debemos especificar la ruta donde se guardaran los archivos (Esta carpeta la creamos manualmente).

Nota: solo funciona con archivos zip

Para mas información de configuración ver: Como utilizar el Editor VBA en Office (Utilizar Macros VBScript) y Outlook – Crear y configurar reglas

Código

Sub saveAllEmailInFolderToTXT()
Dim objItem As Outlook.MailItem
Dim sSubject As String
Dim dDate As Date

For Each objItem In ActiveExplorer.CurrentFolder.Items
sSubject = objItem.Subject
ReplaceIllegalChars sSubject, "-"
dDate = objItem.ReceivedTime
objItem.SaveAs "C:1-Tests" & sSubject & ".txt", olSaveAsText
Next

End Sub

Private Sub ReplaceIllegalChars(sSubject As String, sChr As String)

  sSubject = Replace(sSubject, "/", sChr)
  sSubject = Replace(sSubject, "", sChr)
  sSubject = Replace(sSubject, ":", sChr)
  sSubject = Replace(sSubject, "?", sChr)
  sSubject = Replace(sSubject, Chr(34), sChr)
  sSubject = Replace(sSubject, "<", sChr)
  sSubject = Replace(sSubject, ">", sChr)
  sSubject = Replace(sSubject, "|", sChr)
  sSubject = Replace(sSubject, "*", sChr)
End Sub