Em termos de VBA o Outlook é bem diferente dos outros aplicativos. O Outlook trabalha apenas com um projeto chamado VbaProject.OTM. Este arquivo, geralmente, encontra-se na pasta Drive:\Documents and Settings\Usuário\Dados de aplicativos\Microsoft\Outlook. Contudo, se ele não estiver presente em seu computador isso significa que você jamais criou um projeto VBA no Outlook, pois o arquivo somente é gerado quando um projeto é iniciado.

Este projeto é “standalone” e é para ser rodado em uma máquina apenas. Então, se você pretende utilizá-lo no seu trabalho lembre-se de alguns pontos:

1. Criar um certificado digital local (ou modifique o nível de segurança de macros)
2. Deployment

Caso você não crie um certificado digital para o projeto (ou modifique o nível de segurança de macros para baixo), sempre que o Outlook for aberto a seguinte mensagem será mostrada:

Figura 5‑1

Se o usuário desabilitar as macros o seu monitoramento de e-mails falhará.

A figura abaixo mostra o certificado aplicado a este projeto:

Figura 5‑2

Este é um “auto certificado” criado na própria máquina local:

Figura 5‑3

O certificado pode ser criado utilizando a ferramenta de criação de certificados para projetos VBA do Office.

Uma outra questão diz repeito aos objetos do Outlook. Aqui, utilizo o Redemption para evitar as mensagens de segurança:

Figura 5‑4

A mensagem aparecerá independentemente de estarmos codificando dentro do Outlook ou não.

A segunda questão diz respeito ao “deployment” (distribuição) do aplicativo. Este tipo de projeto precisa ser distribuído um a um para cada máquina. Diferentemente do Excel e Word onde nós podemos distribuir AddIns (Suplementos) no Outlook não podemos fazê-lo utilizando o projeto VBA nele criado.

O projeto deste tópico contém os seguintes itens:

1. Projeto VBA do Outlook
2. Um banco de dados

O banco de dados contém o básico para manter um controle dos e-mails. A idéia do controle é saber o que é enviado e recebido pelo usuário. O corpo da mensagem e informações sobre a mensagem são gravadas no banco de dados e as informações podem, subsequentemente, ser recuperados para saber que tipos de mensagens são recebidas e enviadas pelo usuário.

Monitorando chegada e enviando de e-mails

Antes de mais nada, precisamos criar nosso banco de dados. O BD do exemplo é composto por duas tabelas. Uma tabela para gravar os dados e uma tabela de ações:

Figura 5‑5

A tabela acima mostra algumas das ações possíveis e sugeridas. Não cobrirei todas as ações, pois o objetivo deste curso não é desenvolver o aplicativo completo, mas desenvolver a idéia e deixar que o leitor desenvolva em cima das sugestões dadas.

As tabelas são relacionadas para facilitar a criação de relatórios. Por exemplo, você poderia criar um relatório de mensagens enviadas e/ou recebidas, etc.

No código de exemplo, o BD está sob a raiz do diretório C e o nome dele é “outlooklog.mdb”.

Para este exemplo, precisaremos de um módulo de classe e um módulo VBA. Adicione estes dois módulos em seu projeto no Outlook. Abaixo quebro o código em Classe e Módulo com a explicação dentro de cada um.

Antes de mais nada, abra o VBE do ThisOutlookSession onde as seguinte linhas de código devem ser entradas:

Private Sub Application_Startup()
      Call IniciarClasses
End Sub

O código acima chama a rotina IniciarClasses que criaremos mais adiante. Este rotina por sua vez iniciará a classe que criaremos e a qual controlará os eventos de chegada e envio de e-mails.

Adicione um módulo VBA onde o seguinte código deve ser inserido:

Sub IniciarClasses()
    On Error  Resume Next
'   Iniciar as classes
    olClsItens.Initialize_handler
    olClsOL.Initialize_handler 
End Sub

O código de Inicialização é bastante simples e não há muito que explicar. Observe, porém, que estamos iniciando duas classes neste mesmo código. A classe olClsItens é a classe que desenvolveremos no exemplo do próximo tópico.

Adicione agora um módulo de classe e chame de olClsOL. Neste classe adicionaremos o código:

'   Define os eventos do aplicativo para monitoração
    Public WithEvents OlApp     As Outlook.Application
   
'   Define o item de e-mail para ser monitorado
    Dim email                   As Outlook.MailItem
   
'   Define o item de e-mail seguro usando o Redemption
    Dim safeEmail               As Redemption.SafeMailItem

' Inicialização do evento da classe
Sub Initialize_handler()
    Set OlApp = CreateObject("Outlook.Application")
End Sub

' Evento de envio de e-mail
Private Sub OlApp_ItemSend(ByVal Item As Object, Cancel As Boolean)

'   Em caso de erro ir para o Error_Handler
    On Error GoTo Error_Handler

'   Define o email como sendo o item passado
'   Note que o Item não é necessariamente um e-mail.
'   Veja explicação no módulo
    Set email = Item

'   Chama a rotina para processar o email
    Call processar(5, email)

Limpar:
'   Limpa o objeto da memória
    Set email = Nothing
    Exit Sub

' Passa uma mensagem de erro para o usuário.
Error_Handler:
    Call erros(Err.Number, Err.Description, "ItemSend")
    GoTo Limpar
End Sub

' Evento de recebimento de email
Private Sub OlApp_NewMailEx(ByVal EntryIDCollection As String)
       
'   Em caso de erro ir para o Error_Handler
    On Error GoTo Error_Handler
          
'   Declara as variáveis
    Dim intInicial      As Integer
    Dim intFinal        As Integer
    Dim strEntryID      As String
    Dim intComp         As Integer

'   Posição inicial da strEntryID
    intInicial = 1

'   Comprimento do ID de entrada da mensagem
    intComp = Len(EntryIDCollection)

'   remove o ID da mensagem
    strEntryID = Mid(EntryIDCollection, intInicial, (intComp - intInicial) + 1)

'   Define a mensagem a partir da ID da mensagem
    Set email = Application.Session.GetItemFromID(strEntryID)

'   Chama a rotina de processamento do email que acabou de chegar
    Call processar(1, email)

'   Limpa a memória
Limpar:
    Set email = Nothing
    Exit Sub

' Passa uma mensagem de erro para o usuário.
Error_Handler:
    Call erros(Err.Number, Err.Description, "NewMailEx")
    GoTo Limpar
End Sub

' Rotina para processar o email
Private Sub processar(ByVal IDAcao As Integer, obj As Object)
   
'   Em caso de erro ir para o Error_Handler
    On Error GoTo Error_Handler
   
'   Declara as variáveis
    Dim intInicial      As Integer
    Dim intFinal        As Integer
    Dim strEntryID      As String
    Dim intComp         As Integer

'   Declara as variáveis do BD
    Dim cn              As String
    Dim sql             As String
    Dim rs              As ADODB.Recordset
   
'   Define a string de conexão ao BD
    cn = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & dbNome & ";"
   
'   MailItem causará erro se objeto diferente de MailItem. Passar para Error_handler
    Set email = obj

'   Cria um novo objeto safemail
    Set safeEmail = New Redemption.SafeMailItem

'   Define o objeto safemail como sendo o e-mail
    safeEmail.Item = email
   
'   Cria um novo recordset
    Set rs = New ADODB.Recordset

'   Com o recordset
    With rs

'       Define a string de conexão do recordset
        .ActiveConnection = cn

'       Define a tabela fonte
        .Source = "tblLogs"

'       Define o tipo de cursor
        .CursorType = adOpenKeyset

'       Define a posição do cursor
        .CursorLocation = 2

'       Define o tipo de "Lock" (travamento) de registro
        .LockType = adLockOptimistic

'       Abre o recordset
        .Open
    End With

'   Seleciona o tipo de ação passada para processamento
    Select Case IDAcao
'       Caso 1, novo e-mail recebido
        Case 1
            With rs
                .AddNew
                .Fields("IDacao") = IDAcao:
                .Fields("Remetente") = safeEmail.SenderName
                .Fields("IDEmail") = email.EntryID
                .Fields("EmailRemetente") = safeEmail.SenderEmailAddress:
                .Fields("Assunto") = email.Subject
                .Fields("Corpo") = safeEmail.Body
                .Fields("DataChegada") = email.ReceivedTime
                .Fields("DataEnvio") = email.SentOn
                .Update
            End With
 
 '      Caso5, novo e-mail enviado
        Case 5
            With rs
                .AddNew
                .Fields("IDacao") = IDAcao
                .Fields("Destinatario") = safeEmail.To & ";" _
& safeEmail.CC & "; " & safeEmail.BCC
                .Fields("IDEmail") = email.EntryID
                .Fields("EmailDestinatario") = safeEmail.To _
& ";" & safeEmail.CC & "; " & safeEmail.BCC
                .Fields("Assunto") = email.Subject
                .Fields("Corpo") = safeEmail.Body
                .Fields("DataEnvio") = Now
                .Update
            End With
'       Outros casos nao definidos
        Case Else
            GoTo Case_Else
    End Select

' Limpa os objetos da memória
Limpar:
    rs.Close
    Set rs = Nothing
    Set email = Nothing
    Set safeEmail = Nothing
   
    Exit Sub

Error_Handler:
    Call erros(Err.Number, Err.Description, "processar")
    GoTo Limpar
    Exit Sub

Case_Else:
    MsgBox "Favor comunicar erro 'Case_Else:' ao administrador", vbCritical
    GoTo Limpar
    Exit Sub
End Sub

' Rotina de erros
Private Sub erros(ByVal número As Long, ByVal descricao As String, _
    ByVal chamadoPor As String)

    MsgBox "Um erro ocorreu. Favor reportar erro em '" & chamadoPor & "' para o administrador" _
        & " passando a seguinte informação:" & vbCr & vbCr _
        & "Número do erro: " & número & vbCr _
        & "Descrição do erro: " & descricao, vbCritical
       
End Sub

É provável que o leitor esteja questionando os motivos para utilizar 1 e 5 na instrução Select Case. O código original que desenvolvi possui outras opções, contudo, neste módulo apenas apresento parte do código.

Uma outra questão importante diz respeito aos erros. Aqui, apresento um tratamento o qual passa a seguinte mensagem para o usuário:

Figura 5‑6

Não obstante, se o leitor realmente deseja que o usuário não saiba o que está ocorrendo ou não queira intervenção do usuário, o erro acima pode ser suprimido e/ou substituído por uma rotina que envia um email para o administrador avisando sobre o erro ocorrido.

Uma vez que o código esteja rodando os emails recebidos e enviados serão gravados na banco de dados. A figura abaixo mostra parte dos mais de 800 emails monitorados em minha máquina (somente recebimentos):

Figura 5‑7

O proximo exemplo lida com deleção de e-mails.

Monitorando deleção de e-mails

Este exemplo é uma continuação do exemplo anterior. Aqui mostrarei como criar o evento para controlar itens enviados para a caixa de itens removidos. O banco de dados continuará o mesmo e utilizaremos uma nova classe a qual deve ser chamada de clsItens.

Com a classe criada estamos prontos para iniciar o nosso código. Não há muita diferença entre este exemplo e o anterior, excluindo a forma como os itens são manipulados na caixa de itens removidos:

'Eventos para o DeletedItems
Public WithEvents olfldDeleted      As Outlook.Items

Dim OlApp2                          As New Outlook.Application
Private Const dbNome                As String = "c:\outlooklog.mdb"
Dim email                           As MailItem
Dim safeEmail                       As Redemption.SafeMailItem

Public Sub Initialize_handler()
    Set olfldDeleted = OlApp2.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).Items

End Sub

'Evento ItemAdd para a pasta DeletedItems
Private Sub olfldDeleted_ItemAdd(ByVal Item As Object)

'   Em caso de erro ir para o Error_Handler
    On Error GoTo Error_Handler
   
'   Chama a rotina para processar o email
    Call processar(8, Item)
    Exit Sub
   
' Passa uma mensagem de erro para o usuário.
Error_Handler:
    Call erros(Err.Number, Err.Description, "olfldDeleted_ItemAdd")
End Sub

Private Sub olfldDeleted_ItemChange(ByVal Item As Object)
'   Em caso de erro ir para o Error_Handler
    On Error GoTo Error_Handler
   
'   Chama a rotina para processar o email
    Call processar(9, Item)
    Exit Sub
   
' Passa uma mensagem de erro para o usuário.
Error_Handler:
    Call erros(Err.Number, Err.Description, "olfldDeleted_ItemChange")
End Sub

' Rotina para processar o email
Private Sub processar(ByVal IDAcao As Integer, obj As Object)
   
'   Em caso de erro ir para o Error_Handler
    On Error GoTo Error_Handler
   
'   Declara as variáveis
    Dim intInitial      As Integer
    Dim intFinal        As Integer
    Dim strEntryID      As String
    Dim intLength       As Integer

'   Declara as variáveis do BD
    Dim cn              As String
    Dim sql             As String
    Dim rs              As ADODB.Recordset
   
'   Define a string de conexão ao BD
    cn = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & dbNome & ";"
   
'   MailItem causará erro se objeto diferente de MailItem. Passar para Error_handler
'   Veja explicação e sugestão no tópico anterior
    Set email = obj
   
'   Cria um novo objeto safemail
    Set safeEmail = New Redemption.SafeMailItem

'   Define o objeto safemail como sendo o e-mail
    safeEmail.Item = email

'   Cria um novo recordset
    Set rs = New ADODB.Recordset

'   Com o recordset
    With rs

'       Define a string de conexão do recordset
        .ActiveConnection = cn

'       Define a tabela fonte
        .Source = "tblLogs"

'       Define o tipo de cursor
        .CursorType = adOpenKeyset

'       Define a posição do cursor
        .CursorLocation = 2

'       Define o tipo de "Lock" (travamento) de registro
        .LockType = adLockOptimistic

'       Abre o recordset
        .Open
    End With
   
'   Seleciona o tipo de ação passada para processamento
    Select Case IDAcao
        Case 8
            With rs
                .AddNew
                .Fields("IDacao") = IDAcao
                .Fields("Remetente") = safeEmail.SenderName
                .Fields("IDEmail") = email.EntryID
                .Fields("EmailRemetente") = safeEmail.SenderEmailAddress
                .Fields("Assunto") = email.Subject
                .Fields("Corpo") = safeEmail.Body
                .Fields("DataChegada") = email.ReceivedTime
                .Fields("DataEnvio") = email.SentOn
                .Fields("DataDelecao_Modificacao") = Now
                .Update
            End With

        Case 9
            With rs
                .AddNew
                .Fields("IDacao") = IDAcao
                .Fields("Remetente") = safeEmail.SenderName
                .Fields("IDEmail") = email.EntryID
                .Fields("EmailRemetente") = safeEmail.SenderEmailAddress
                .Fields("Assunto") = email.Subject
                .Fields("Corpo") = safeEmail.Body
                .Fields("DataChegada") = email.ReceivedTime
                .Fields("DataDelecao_Modificacao") = Now
                .Update
            End With

        Case Else
            GoTo Case_Else
    End Select
   
' Limpa os objetos da memória
Limpar:
    rs.Close
    Set rs = Nothing
    Set email = Nothing
    Set safeEmail = Nothing
   
    Exit Sub

Error_Handler:
    Call erros(Err.Number, Err.Description, "processar")
    GoTo Limpar
    Exit Sub

Case_Else:
    MsgBox "Favor comunicar erro 'Case_Else:' ao administrador", vbCritical
    GoTo Limpar
    Exit Sub

End Sub

Private Sub erros(ByVal número As Long, ByVal descricao As String, _
    ByVal chamadoPor As String)

    MsgBox "Um erro ocorreu. Favor reportar erro em '" & chamadoPor & "' para o administrador" _
        & " passando a seguinte informação:" & vbCr & vbCr _
        & "Número do erro: " & número & vbCr _
        & "Descrição do erro: " & descricao, vbCritical
       
End Sub

O BD para exemplo que acompanha este modulo possui o nome deste tópico para fácil referência. Modifique o nome para outlooklog.mdb e coloque-o em C:\.

Veja algumas das opções do banco de dados.