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

 

Califica este articulo

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.

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

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

  2. 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?

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

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

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

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

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

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

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

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

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

  8. 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
        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
  9. 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?

Deja un comentario...

Compartir
Twittear
+1
Compartir
Pin
Stumble