TU ANUNCIO / YOUR PUBLICITY

AQUÍ PODRÍA ESTAR TU ANUNCIO: / HERE COULD BE YOUR AD E-mail

viernes, 26 de junio de 2015

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:

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:


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.



No hay comentarios:

Publicar un comentario