Saltar al contenido

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

 

Leer entrada anterior
Configurar paso a paso y entrar a IDSE en Windows 10

Recientemente la mayoría de los equipos comienzan a solicitar actualizar a Windows 10 y muchos usuarios ya hemos accedido a...

Cerrar