VBScript – Guardar Correos Seleccionados en un Archivo 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 realiza lo siguiente: Guarda los correos que seleccionemos previamente cada uno en un archivo TXT en una carpeta que indiquemos.

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).

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

Codigo

Sub saveSelectedEmailToTXT()
Dim objItem As Outlook.MailItem
Dim sSubject As String
Dim dDate As Date
Dim iCount As Integer

For Each objItem In ActiveExplorer.Selection
'Set objItem = Application.ActiveExplorer.Selection.Item(1)
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