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

 

Entradas relacionadas

Deja un comentario

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.

Comentarios (25)

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

Responder

Buen dia

Puedes ver el siguiente Script en el articulo (AQUI)

Saludos.

Responder

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?

Responder

Buen dia Andrea

Una disculpa, agrego el Código modificado para que guarde el correo entrante.

Saludos.

Responder

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!! 🙂

Responder

Buen dia Andrea

Se agrego al nombre la hora de recepción del correo para que no se dupliquen cuando un correo llegue con el mismo Asunto.

Saludos.

Responder

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

Responder

Buen dia Andrea!

Se agrego la linea requerida al Código y algunos comentarios si requieres realizar algún cambio

Saludos.

Responder

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

Responder

Buen dia Andrea!

Revisa el código que se actualizo en el sitio, creo que te va a servir el cambio, nos avisas.

Saludos.

Responder

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

Responder

Buen dia Andrea!

Excelente, Normalmente es por parte de la regla, cuando algo no lo puede procesar el Script normalmente marca error. puedes revisar que continúen habilitados los macros, ha tocado que despues de una actualización de sistema dejan de funcionar los scripts porque regresa la configuración de seguridad predeterminada.

Nos comentas.

Saludos.

Responder

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!!

Responder

Buen dia Alex!

Si debe ser posible aplicarlo en Outlook lo he visto aplicado en Excel, es un poco diferente ya que excel cuenta con celdas el cual se pueden convertir a Tab delimited…
El actual código no se puede modificar para realizar esto ya que se indica guardar en TXT implícitamente y no se procesa el texto como para añadir las separaciones o conservar cualquier otro formato.

Saludos.

Responder

Hola Fernando, muchas gracias por tu respuesta. La verdad que he estado buscando cómo hacerlo y no no he tenido suerte. Seguiré buscando!
Gracias y saludos.

Responder

Perdón Fernando, otra consulta, habrá alguna otra forma de guardar el cuerpo del mail conservando el formato original? Yo intuí que la mejor forma era .txt pero no necesariamente lo necesito en ese formato. El caso es que luego voy a trabajar los datos del mail en un excel y necesitaría poder importarlo con el mismo formato. Luego en excel me encargo de hacer la tabulación que necesite.
Muchas gracias de antemano.
Saludos!

Responder

Buen dia Alex

Honestamente desconozco como se puede guardar en TXT o Excel conservando el formato original, lo que he utilizado procesa el texto y pierde todo formato en este paso asi que si quiero exportarlo a un documento de Word tampoco conserva el formato original. ¿No te sirve guardar el correo como mensaje? ya que entiendo que ocupas archivarlos para después re trabajar los datos, podrías utilizar el siguiente VBScript – Guardar Correos Entrantes a una Carpeta en el Disco (.MSG) Outlook para guardar los correos entrantes deseados por medio de una regla.

Nos comentas si te es de ayuda. También si logras encontrar como conservar el formato te agradecería que nos retroalimentes con la información.

Saludos.

Hola! La verdad que me abriste los ojos con esa opción de descargar primero el correo como tal (.MSG) y luego trabajarlo. Después de investigar un poco sobre eso, llegué a una alternativa que me resuelve el problema, y es descargar el correo pero con formato “.MHT”. A partir de ahí pude importarlo desde Excel y tabularlo a mi gusto. Muchísimas gracias por tu ayuda y dedicación!!
El código que usé es básicamente el mismo que indicas en el link de arriba, sólo cambié las siguientes líneas:

(…)
sSubject = Format(dDate, “yyyymmdd”) & Format(dDate, “-hhnnss”) & “-” & sSubject & “.mht”

(..)

Item.SaveAs sPath & sSubject, olMHTML

Ojalá le sirva a alguien!
Un abrazo.

Buen dia
Que bueno que ya lograste realizar tu objetivo, gracias por la retro alimentación con el código que utilizaste Alex.
Saludos.

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 & \"Documentstest.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
strColE = olItem.To
strColF = olItem.ReceivedTime

\' Get the Exchange address
\' if not using Exchange, this block can be removed
Dim olEU As Outlook.ExchangeUser
Dim oEDL As Outlook.ExchangeDistributionList
Dim recip As Outlook.Recipient
Set recip = Application.Session.CreateRecipient(strColC)

If InStr(1, strColC, \"/\") > 0 Then
\' if exchange, get smtp address
Select Case recip.AddressEntry.AddressEntryUserType
Case OlAddressEntryUserType.olExchangeUserAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olOutlookContactAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
Set oEDL = recip.AddressEntry.GetExchangeDistributionList
If Not (oEDL Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
End Select
End If
\' End Exchange section

\'write them in the excel sheet
xlSheet.Range(\"B\" & rCount) = strColB
xlSheet.Range(\"c\" & rCount) = strColC
xlSheet.Range(\"d\" & rCount) = strColD
xlSheet.Range(\"e\" & rCount) = strColE
xlSheet.Range(\"f\" & rCount) = strColF

\'Next row
rCount = rCount + 1

Next

xlWB.Close 1
If bXStarted Then
xlApp.Quit
End If

Set olItem = Nothing
Set obj = Nothing
Set currentExplorer = Nothing
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
End Sub

Responder

Buen dia Carlos,

Tenemos un articulo con lo que deseas (Es el mismo código pero modificado para lo que deseas): VBScript – Exportar Información de correos Outlook a Excel.

En tu codigo es porque estas indicando la seleccion:

Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection

Saludos.

Responder

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?

Responder

Buen dia Miguel

Es posible si existe un dato en común en el cuerpo de correo o si siempre esta posicionado en el mismo lugar.

Contienen algo los correos?

Responder

Fernando, buen día,

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

Agradezco cualquier ayuda.

Responder

Buen dia Ricardo,

En archivo txt no es posible pegar imágenes. En caso te puede servir el siguiente.

VBScript para guardar automáticamente archivos adjuntos Outlook

Como la imagen en el cuerpo del correo es tomada como adjunto el script te la detecta.

Excelente dia.

Responder
Leer entrada anterior
Configurar paso a paso y entrar a IDSE en Windows 10
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