Reading data from files msg (Outlook) with VB6 / Lectura de datos de ficheros msg (de Outlook) con VB6

Vamos a exponer, no una sino 3 formas diferentes de poder obtener los datos de un fichero de formato msg de Outlook

Let's expose, not one but three different ways to get data from "msg" file format of Outlook.

Sistema 1: con la ayuda de EAGetMailObj / System 1: with the help of EAGetMailObj

Se incorpora como referencia de esta manera:

It is incorporated by reference in this way

Si no tenemos esta biblioteca se consigue instalando EASendMail:

If you do not have this library is achieved by installing EASendMail:

Se puede descargar el programa desde aquí:

You can download the program here:

 https://www.emailarchitect.net/downloads.aspx

También se puede buscar EASendMail y buscarlo por nuestra cuenta. Una vez instalado, ya tendremos este componente para nuestros programas de VB. Necesitamos instalarlo peno no hace falta usarlo. Lo importante es tener este grupo de bibliotecas dll:

You can also search EASendMail and look for ourselves. Once installed, we will have this component to our programs VB. Penile need to install needless use. The important thing is to have this group of dll libraries:

La función que necesitaremos será algo parecida a ésta:

The function we need is something like this:

Sub LeeMSG(ByVal msgF As String)

    Dim oCorreo As New EAGetMailObjLib.Mail

    oCorreo.LicenseCode = "TryIt"

On Error GoTo 100

 Dim texto As String

 texto = ""

 Dim previo As String

    oCorreo.LoadOMSGFile msgF

    Dim Destinatarios

    Dim i As Integer

    Dim Destinatario As EAGetMailObjLib.MailAddress

  

        'MOSTRANDO FECHA

        MsgBox oCorreo.SentDate

        'MOSTRANDO Remitente

        MsgBox oCorreo.From.Address

        'MOSTRANDO DESTINATARIOS

        Destinatarios = oMail.To

        For i = LBound(Destinatarios) To UBound(Destinatarios)

            Set Destinatario = Destinatarios(i)

            MsgBox Destinatario.Address

        Next

    

        'MOSTRANDOS CON COPIAS

        Destinatarios = oMail.Cc

        For i = LBound(Destinatarios) To UBound(Destinatarios)

            Set Destinatario = Destinatarios(i)

            MsgBox Destinatario.Address

        Next

        'MOSTRANDO ASUNTOS

         MsgBox oCorreo.Subject

  

       ' MOSTRANDO TEXTO DEL CORREO

       'MsgBox "Texto del correo: " & oCorreo.TextBody

       ' MOSTRANDO HTML body

       'MsgBox "CUERPO Html: " & oCorreo.HtmlBody

       'filecopy msgfiletexto+".msg"

    

       ' MOSTRANDO ADJUNTOS

       'Dim adjuntos

       'Dim adjunto As EAGetMailObjLib.Attachment

       'adjuntos = oCorreo.Attachments

       'For i = LBound(adjuntos) To UBound(adjuntos)

       '    Set adjunto = adjuntos(i)

       '    MsgBox "Adjuntos: " & adjunto.Name

       'Next

    Exit Sub

10:

    'MsgBox Err.Description

End Sub

Hasta aquí mostramos como obtener los datos y visualizarlos con un mensaje de texto pero es obvio que se puede hacer cualquier cosa con ellos.

Thus far we show how to obtain the data and view them with a text message but obviously you can do anything with them.

Sistema 2: Con la ayuda de msgtool.exe / System 2 With the help of msgtool.exe

Puedes descargarlo de: You can download from:

https://code.google.com/p/ruby-msg/downloads/detail?name=msgtool-1.3.1-mswin32-stand_alone.zip&can=2&q=

O simplemente buscando msgtools en Google.

Or just looking msgtools in Google.

Nos dará un comando para utilizar en linea:

This will give us a command to use:

                    msgtool -c origen.msg > destino.eml

Podría utilizarse la función Shell de VB. Al ser esta función asíncrona es posible que cuando quisiñeramos leer los datos del fichero de texto "eml" todavía no se hubiera creado. por ello utilizaremos la función Ejecutar:

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long

Const STILL_ACTIVE = &H103

Const PROCESS_QUERY_INFORMATION = &H400

Public Sub Ejecutar(ByVal CmdLine As String)

On Error GoTo 20

Dim hProcess As Long

Dim RetVal As Long

hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(Chr(34) + CmdLine + Chr(34), 7))

Do

    GetExitCodeProcess hProcess, RetVal

    DoEvents

Loop While RetVal = STILL_ACTIVE

Exit Sub

20 MsgBox "error"

End Sub

La segunda pega consiste en la decodificación UTF-8. Podríamos utilizar las siguientes funciones de codificación-decodificación:

Function isUTF8(ByVal ptstr As String)

    Dim tUTFencoded As String

    Dim tUTFencodedaux

    Dim tUTFencodedASCII As String

    Dim ptstrASCII As String

    Dim iaux, iaux2 As Integer

    Dim ffound As Boolean

    ffound = False

    ptstrASCII = ""

    For iaux = 1 To Len(ptstr)

        ptstrASCII = ptstrASCII & Asc(Mid(ptstr, iaux, 1)) & "|"

    Next

    tUTFencoded = "Ä|Ã…|Ç|É|Ñ|Ö|ÃŒ|á|à |â|ä|ã|Ã¥|ç|é|è|ê|ë|í|ì|î|ï|ñ|ó|ò|ô|ö|õ|ú|ù|û|ü|â€|°|¢|£|§|•|¶|ß|®|©|â„¢|´|¨|â‰|Æ|Ø|∞|±|≤|≥|Â¥|µ|∂|∑|∏|Ï€|∫|ª|º|Ω|æ|ø|¿|¡|¬|√|Æ’|≈|∆|«|»|…| |À|Ã|Õ|Å’|Å“|–|—|“|”|‘|’|÷|â—Š|ÿ|Ÿ|⁄|€|‹|›|fi|fl|‡|·|‚|„|‰|Â|Ú|Á|Ë|È|Í|ÃŽ|Ï|ÃŒ|Ó|Ô||Ã’|Ú|Û|Ù|ı|ˆ|Ëœ|¯|˘|Ë™|Ëš|¸|˝|Ë›|ˇ|Å |Å¡|¦|²|³|¹|¼|½|¾|Ð|×|Ý|Þ|ð|ý|þ|â‰|∞|≤|≥|∂|∑|∏|Ï€|∫|Ω|√|≈|∆|â—Š|⁄|fi|fl||ı|˘|Ë™|Ëš|˝|Ë›|ˇ"

    tUTFencodedaux = Split(tUTFencoded, "|")

    If UBound(tUTFencodedaux) > 0 Then

        iaux = 0

        Do While Not ffound And Not iaux > UBound(tUTFencodedaux)

            If InStr(1, ptstr, tUTFencodedaux(iaux), vbTextCompare) > 0 Then

                ffound = True

            End If

            If Not ffound Then

                tUTFencodedASCII = ""

                For iaux2 = 1 To Len(tUTFencodedaux(iaux))

                    tUTFencodedASCII = tUTFencodedASCII & Asc(Mid(tUTFencodedaux(iaux), iaux2, 1)) & "|"

                Next

                If InStr(1, ptstrASCII, tUTFencodedASCII) > 0 Then

                    ffound = True

                End If

            End If

            iaux = iaux + 1

        Loop

    End If

    isUTF8 = ffound

End Function

Function DecodeUTF8(s)

  Dim i

  Dim c

  Dim n

  s = s & " "

  i = 1

  Do While i <= Len(s)

    c = Asc(Mid(s, i, 1))

    If c And &H80 Then

      n = 1

      Do While i + n < Len(s)

        If (Asc(Mid(s, i + n, 1)) And &HC0) <> &H80 Then

          Exit Do

        End If

        n = n + 1

      Loop

      If n = 2 And ((c And &HE0) = &HC0) Then

        c = Asc(Mid(s, i + 1, 1)) + &H40 * (c And &H1)

      Else

        c = 191

      End If

      s = Left(s, i - 1) + Chr(c) + Mid(s, i + n)

    End If

    i = i + 1

  Loop

  DecodeUTF8 = s

End Function

Como el fichero "eml" es de texto simplemente es entretenido obtener la información con las clásicas funciones de text Right, Left, Mid y Replace.

As the file "eml" is text, it's just fun to get the information with the classic text functions Right, Left, Mid and Replace.

Solución 3: Con la biblioteca de Outlook / Solution 3: With the Outlook library.

Esta solución es la que menos me gusta porque es rendirse a Microsoft. Pero cuando todo lo demás falla y estamos obligados a trabajar con el formato msg. ¿Qué se puede hacer?

Añadimos en Referencias la biblioteca de Outlook e incorporamos el siguiente extracto de código donde queramos:

References add Outlook library and add the following code excerpt where we want:

Dim ol As Outlook.Application

Dim msg As Outlook.MailItem

Set ol = New Outlook.Application

Set msg = ol.CreateItemFromTemplate(eso)

    MsgBox msg.SenderEmailAddress

    MsgBox msg.ReceivedTime

    MsgBox msg.To

    MsgBox msg.Subject

...

Set ol = Nothing

Set msg = Nothing

En lugar de utilizar la función MsgBox para visualizar los datos podemos hacer cualquier otra cosa con estos datos.

Instead of using the MsgBox function to display data we can do anything with this information.

NOTA IMPORTANTE: Puede saltarlos este mensaje:

IMPORTANT NOTE: It can be shown this message:

Si no queremos que salga tendremos que abrir Outlook, >> Programador >> Seguridad de Macros >> Acceso mediante programación >> No avisarme nunca de actividad sospechosa.

Está claro que de nosotros si nos podemos fiar pero hemos dejado la puerta abierta para otros. CUIDADO, Como siempre en Microsoft, la seguridad es parcial.

It is clear that for us if we can trust but have left the door open for others. CARE, As always Microsoft, security is partial.