VBScript – Guardar Cuerpo de Correo Entrante en Archivo de Texto (TXT) Outlook

Este script es respondiendo una solicitud de un usuario, el cual lo que desea es guardar cuerpo de correo entrante en archivo de texto, el siguiente script  básicamente lo que realiza es: cada correo electrónico entrante (o cumpliendo la configuración de la regla) 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

Actualización 07-Octubre-2016

• Se corrige el error al momento de guardar correos con caracteres no validos.
• Se añade hora al nombre del archivo.
• Se agregan fecha y hora al cuerpo de correo
• Se agregan comentarios a las lineas principales de código

Sub SaveIncomingEmailToTXT(itm As Outlook.MailItem)
Dim objItem As Object
Dim sSubject As String
Dim dDate As Date

sSubject = itm.Subject
dDate = itm.ReceivedTime
ReplaceIllegalChars sSubject, "-"
'Esta linea toma la fecha que se recibe el correo y el Asunto
sSubject = Format(dDate, "yyyy-mm-dd-hh-mm-ss") & "-" & sSubject
'Esta linea agrega la fecha que se recibe el correo al cuerpo.
itm.Body = Format(dDate, "dd/mm/yyyy hh:mm:ss") & vbCrLf & itm.Body
'Esta linea guarda los cambios en el correo (no es requerido al menos que se desee)
'itm.Save
itm.SaveAs "C:1-Tests" & sSubject & ".txt", olSaveAsText

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