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:  VBScript - Guardar archivos adjuntos de los correos seleccionados Outlook
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)

25
Deja una respuesta

avatar
 
Archivos de fotos e imágenes
 
 
 
Archivos de audio y video
 
 
 
Otros tipos de archivos
 
 
 
10 Hilos de comentarios
15 Respuestas de hilo
0 Seguidores
 
Comentario más reaccionado
Hilo de comentarios más caliente
7 Autores de comentarios
RicardoMiguel RiveraCarlosAlexFernando O. 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
Enrique Martínez
Guest
Enrique Martínez

Hola, saludos, soy Enrique desde Puebla En México, me han parecido excelentes tus ejemplos de vba, me han servido muchísimo, gracias.
Una duda, tienes algún código que permita que en cuanto llegue un correo se pueda guardar el *.msg del mismo al disco duro a través de una regla de correo insertando en la regla el script, me sería de gran ayuda.
Nuevamente gracias

andrea
Guest
andrea

Hola Fernando, me podrías ayudar????
Estoy utilizando tu codigo. pero no me transforma el email entrante. Sino el que se encuentra seleccionado en ese momento, en el que aplico la regla para un determinado mensaje.

Pero no me transforma el mensaje que llega. Si el cursor está posicionado en otro mensaje y entra el que necesito transformar. No lo hace. Transforma el q estaba seleccionado.

Como hago para que transforme el que entra?

andrea
Guest
andrea

Hola Fernando muchas gracias por la ayuda!!! Ahora si lo convierte.

Ahora tengo otro problema…. resulta que necesito que me guarde todos los que transforma y en este caso me los está pisando, dejando sólo el último mail que ingresa.

Te cuento, no se mucho de este tipo de programación por eso te solicito ayuda. Disculpa si soy molesta.

Espero tu respuesta! gracias!! 🙂

andrea
Guest
andrea

Hola Fernando! muchas gracias por tu ayuda.

Tengo que agregar en el cuerpo del txt al INICIO, la fecha y la hora del mail.
Sé que es con este código:
ts.WriteLine DateTime.Now (la necesito con este formato: 16/09/2016 10:19:37)

Según lo que estuve leyendo. Pero la verdad que nose como agregarlo. Me podrías decir cómo es el código? Ya con eso terminaría lo que necesito hacer.

Espero tu respuesta. Me has servido de mucha ayuda. 🙂

andrea
Guest
andrea

Estaba probando con este codigo, pero no funciona.
Sub OpenTextFileTest()
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim fs, f
Set fs = CreateObject(“Scripting.FileSystemObject”)
Set f = fs.OpenTextFile(“d:LocalDatapm13747DesktopDespachos_CAT” & sSubject & “.txt”, ForAppending, True)
f.WriteLine DateTime.Now
f.Write (itm.Body)
f.Close
End Sub

Necesito que le agregue la fecha y hora al mail que entra y transforma en txt. Osea que deberia abrilo y escribirlo

andrea
Guest
andrea

Hola Fernando como estás? Me sirvió de mucha ayuda tu código. Y lo estoy utilizando.
Sólo que me surgió un inconveniente que te quería consultar.
Te cuento… al código lo estoy utilizando con una regla. El primer día que lo utilicé funcionó bien y me transformó los mails entrantes que queria y que cumplian con la regla del outlook.

Pero al día siguiente ya no los transformó más. Y los mails siguen llegando igual, por lo que deberían cumplir la regla.

Esto tendrá algo que ver con el código??? o será que tengo que configurar algo más en la regla??
Te agradecería tu ayuda porque nose que habrá pasado si el primer día funcionó bien.
Espero tu respuesta.

Gracias

Alex
Guest
Alex

Hola Fernando, ante todo muchísimas gracias por todos estos códigos! Me han sido de gran ayuda y son muy claros en la explicación, se agradece sinceramente!!
Tengo un problema con este código, pues al exportar al txt modifica el formato, y necesitaría que se mantenga en el txt tal como llega.
Lo que me funciona perfecto es la opción manual de “abrir-exportar a un archivo-valores separados por tabulaciones (windows)”… pero quisiera poder crear una regla para que se exporten automáticamente cuando cumple ciertos requisitos como asunto, emisor, etc y no tener que exportar mail por mail manualmente. Sabrás si se puede crear un script para eso? es fundamental lo de valores separados por tabulaciones (windows). Aguardo tu respuesta. Muchísimas gracias!!

Carlos
Guest
Carlos

Buenas Fernando! Estoy trabajando en algo muy parecido a tu funcion pero en vez de .txt lo genero en excel. He recuperado un codigo de una web que me copia la informacion del mail en el excel… Pero solo me lo hace con los mails que tengo seleccionados en el momento en que entra un mail ( pq lo tengo programado asi en una regla). Como puedo hacer para que me coga solo el mail entrante???? Te adjunto el el codigo… Llevo ya tres dias y no se por donde tirar… Gracias! Option Explicit Public Sub CopyToExcel(Item As Outlook.MailItem) Dim xlApp As Object Dim xlWB As Object Dim xlSheet As Object Dim rCount As Long Dim bXStarted As Boolean Dim enviro As String Dim strPath As String Dim currentExplorer As Explorer Dim Selection As Selection Dim olItem As Outlook.MailItem Dim obj As Object Dim strColB, strColC, strColD, strColE, strColF As String 'Dim LastMail As GetLast 'Set Selection = GetLast.Selection ' Get Excel set up enviro = CStr(Environ("USERPROFILE")) 'the path of the workbook strPath = enviro & "\Documents\test.xlsx" On Error Resume Next Set xlApp = GetObject(, "Excel.Application") If Err 0 Then Application.StatusBar = "Please wait while Excel source is opened ... " Set xlApp = CreateObject("Excel.Application") bXStarted = True End If On Error GoTo 0 'Open the workbook to input the data Set xlWB = xlApp.Workbooks.Open(strPath) Set xlSheet = xlWB.Sheets("Hoja1") ' Process the message record On Error Resume Next 'Find the next empty line of the worksheet rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row 'needed for Exchange 2016. Remove if causing blank lines. rCount = rCount + 1 ' get the values from outlook Set currentExplorer = Application.ActiveExplorer Set Selection = currentExplorer.Selection For Each obj In Selection Set olItem = obj 'collect the fields strColC = olItem.SenderEmailAddress strColB = olItem.SenderName strColD = olItem.Subject… Leer mas»

Miguel Rivera
Guest

Hola Fernando, me estan sirviendo muchos los scripts que has compartido para interactuar con outlook. Pero quisiera ver si me puedes apoyar. Necesito que al recibir un correo descargue el documento anexo, pero el nombre que le ponga es un dato especifico que viene en el cuerpo del mensaje del correo electronico. Sera posible?

Ricardo
Guest
Ricardo

Fernando, buen día,

Tienes algún ejemplo donde el cuerpo del correo que quiero guardar es una imagen?

Agradezco cualquier ayuda.

Compartir
Twittear
Pin
Más en Outlook VBScript
VBScript – Descomprimir zip adjunto y guardar los archivos automáticamente Outlook

VBScript – Imprimir adjunto automáticamente al momento de recibir un correo en Outlook

VBScript – Guardar archivos adjuntos de los correos seleccionados Outlook

Cerrar