Important:

Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog podem ser tratados como consultoria freelance.

Views

VBA Excel: Enviando e-mails a partir do Excel

Estender certa praticidade aos nossos clientes, facilitando-lhes o dia-a-dia, é um prazer para nós desenvolvedores, certo? Abaixo replico um post antigo, e agora ampliado, com uma funcionalidade que visa facilitar o compartilhamento do nosso BI (Business Information), BSCs, Dashboards, Scorecards ou mesmo dos relatórios e gráficos que estão contidos em nossos MISs. Como? Enviando-os por e-mail. 

Sugiro algumas aplicabilidades práticas para a utilização do envio automatizado e e-mails:

: : Sabe quando você está responsável por consolidar diversas planilhas em uma só e o pessoal que precisa enviar-lhe as planilhas (ou disponibilizá-las em algum lugar) não o fazem? então, automatize a cobrança por e-mail

: : Ao invés de gastar tempo reunindo todas as planilhas após o fechamento e enviá-las uma-a-uma a todos os gestores, reúna os dados em um só recipiente, crie uma lista de quem receberá as planilhas e pronto!

A primeira opção utiliza o método SEND, e serve como incentivo a sua pesquisa e estudo. 
Sub SendPlanNow()
    ActiveWorkbook.SendMail _

    Recipients:="bernardess@gmail.com", _

    Subject:="Enviando e-mail da aplicação Excel em: " & Format(Date, "dd/mm/yyyy")
End Sub
Outras necessidades vão se desenrolando com o passar do tempo, como por exemplo copiar a pasta ativa (ActiveSheet), envindo a planilha em seguida:


Sub Send1Sheet_ActiveWorkbook()
    ' Criando uma nova planilha (workbook) contendo um Sheet, e enviando-a 
      como um arquivo anexado.

    ThisWorkbook.Sheets(1).Copy   

    With ActiveWorkbook

         .SendMail Recipients:="bernardess@gmail.com", _

          Subject:="Tente contatar-me em: " & Format(Date, "dd/mmm/yy")

         .Close SaveChanges:=False

    End With

End Sub

Outro método que pode ser usado é o Método de Roteirização, este encaminha a pasta de trabalho (worksheet), a partir de uma lista seguindo o roteiro atual, isto nos permite especificar inúmeros destinatários.

Sub RoutingActwBook()
    With ActiveWorkbook

       Let .HasRoutingSlip = True

           With .RoutingSlip

                Let .Delivery = xlOneAfterAnother
                Let .Recipients = Array("bernardess@gmail.com", "inanyplace01@gmail.com", "inanyplace02@gmail.com")
                Let .Subject = "Por favor, dê atenção a este relatório"
                'Let.Message = ""

          End With

        .Route

    End With
End Sub

Um outro problema comum encontrado em diversos códigos onde se faz citação ao envio de e-mails de modo automatizado é a aparição de mensagens similares a:
projeto mas nesta versão existe uma mensagem de alerta que é exibida a cada envio:

"A program is trying to automatically send e-mail..."
"Um programa está tentando enviar..."

Como eliminar de vez esta constante mensagem de exibição?

Bem, a solução não está no MS Excel, neste caso, pois esta solução pode ser implementada em qualquer um dos produtos do MS Office.


Crie um novo módulo no MS Outlook e cole o código abaixo (Agradecimentos antecipados ao Waine Phillips, dono da solução):


Public Function FnSendMailSafe(strTo As String, _

                                strCC As String, _

                                strBCC As String, _

                                strSubject As String, _

                                strMessageBody As String, _

                                Optional strAttachments) As Boolean

    On Error GoTo ErrorHandler:

    Dim MAPISession As Outlook.NameSpace
    Dim MAPIFolder As Outlook.MAPIFolder
    Dim MAPIMailItem As Outlook.MailItem
    Dim oRecipient As Outlook.Recipient
    Dim TempArray() As String
    Dim varArrayItem As Variant
    Dim strEmailAddress As String
    Dim strAttachmentPath As String
    Dim blnSuccessful As Boolean

    'Obtendo o MAPI do objeto NameSpace

    Set MAPISession = Application.Session

    If Not MAPISession Is Nothing Then

      'Logando-se na sessão MAPI

      MAPISession.Logon , , True, False

      'Criando um ponteiro na pasta Outbox

      Set MAPIFolder = MAPISession.GetDefaultFolder(olFolderOutbox)

      If Not MAPIFolder Is Nothing Then

        ' Criando um novo item de e-mail item na pasta "Outbox"

        Set MAPIMailItem = MAPIFolder.Items.Add(olMailItem)

        If Not MAPIMailItem Is Nothing Then
         
          With MAPIMailItem

            'Criando um novo recipiente para TO

                Let TempArray = Split(strTo, ";")

                For Each varArrayItem In TempArray

                    Let strEmailAddress = Trim(varArrayItem)

                    If Len(strEmailAddress) > 0 Then

                        Set oRecipient = .Recipients.Add(strEmailAddress)

                        Let oRecipient.Type = olTo

                        Set oRecipient = Nothing

                    End If
               
                Next varArrayItem
           

            'Criando um recipiente para CC

                Let TempArray = Split(strCC, ";")

                For Each varArrayItem In TempArray

                    Let strEmailAddress = Trim(varArrayItem)

                    If Len(strEmailAddress) > 0 Then

                        Set oRecipient = .Recipients.Add(strEmailAddress)

                        Let oRecipient.Type = olCC

                        Set oRecipient = Nothing

                    End If

                Next varArrayItem
           
            'Criando recipiente para BCC

                Let TempArray = Split(strBCC, ";")

                For Each varArrayItem In TempArray

                    Let strEmailAddress = Trim(varArrayItem)

                    If Len(strEmailAddress) > 0 Then

                        Set oRecipient = .Recipients.Add(strEmailAddress)

                        Let oRecipient.Type = olBCC

                        Set oRecipient = Nothing

                    End If
               

                Next varArrayItem
           

            'Configurado a mensagem do SUBJECT

                Let .Subject = strSubject
           

            'Configurando a mensagem do corpo od e-mail (em HTML ou texto)

                If StrComp(Left(strMessageBody, 6), "<HTML>", vbTextCompare) = 0 Then

                    Let .HTMLBody = strMessageBody

                Else

                    Let .Body = strMessageBody

                End If


            'Adicionando qualquer anexo especificado

                'Let TempArray = strAttachments

                For Each varArrayItem In strAttachments

                    Let strAttachmentPath = Trim(varArrayItem)

                    If Len(strAttachmentPath) > 0 Then
                        .Attachments.Add strAttachmentPath
                    End If
               

                Next varArrayItem

            .Send


            Set MAPIMailItem = Nothing

          End With

        End If

        Set MAPIFolder = Nothing

      End If

      MAPISession.Logoff

    End If


    Let blnSuccessful = True
   

ExitRoutine:

    Set MAPISession = Nothing
    Let FnSendMailSafe = blnSuccessful

    Exit Function


ErrorHandler:

    MsgBox "Occoreu um erro na função VBA FnSendMailSafe()" & vbCrLf & vbCrLf & _

            "Nº do erro: " & CStr(Err.Number) & vbCrLf & _

            "Descrição do erro: " & Err.Description, vbApplicationModal + vbCritical

    Resume ExitRoutine

End Function

Já no MS Excel (ou qualquer outro produto do MS Office), cole o código abaixo:Chame essa função com os parâmetros da mensagem.
No parâmetro TO (Para) e CC é só separar os e-mails com ;[ponto-e-vírgula], e os anexos precisarão estar numa matriz.

Function SendMail (para As String, cc As String, assunto As String, mensagem As String, Anexos) As Boolean
         'enviar e-mail via Outlook
         Dim objOutlook As Object ' Note: Must be late-binding.
         Dim objNameSpace As Object
         Dim objExplorer As Object
         Dim blnSuccessful As Boolean
         Dim blnNewInstance As Boolean 

         On Error Resume Next

         Set objOutlook = GetObject(, "Outlook.Application")

         On Error GoTo 0

         If objOutlook Is Nothing Then
             Set objOutlook = CreateObject("Outlook.Application")

             Let blnNewInstance = True

             Set objNameSpace = objOutlook.GetNamespace("MAPI")
             Set objExplorer = objOutlook.Explorers.Add(objNameSpace.Folders(1), 0)

             objExplorer.CommandBars.FindControl(, 1695).Execute
                   
             objExplorer.Close
               
             Set objNameSpace = Nothing
             Set objExplorer = Nothing
         End If

         Let blnSuccessful = objOutlook.FnSendMailSafe(para, cc, "", assunto, mensagem, Anexos)

         If blnNewInstance = True Then objOutlook.Quit

         Set objOutlook = Nothing

         Let EnviarEmail = blnSuccessful
End Function



A&A® - Work smart, not hard.

Dados ou Informações?

Dados ou Informações?


Empresas em todo o mundo estão permeadas de dados oriundos de diversas fontes distintas e apesar do fácil acesso a estes, têm dificuldades em obter as necessárias informações para suas relevantes tomadas de decisões.

Não é menos verdade, nem tão pouco raro, o fato de que em muitas reuniões a maioria dos diretores, e/ou gerentes presentes estejam munidos de 
informações
 pouco relevantes ou totalmente irrelevantes. É certo que têm acesso aos seus próprios dados de A a Z, mas estes estão completamente desprovidos de conteúdo útil. Geralmente tais amontoados de dados não contém nem a abrangência necessária e tão pouco a diversidade apropriada, que lhes propiciem dinamicidade na análise.

Em alguns casos as corporações têm acesso a uma megabase de 
dados distribuidos nos seus servidores, não raramente reunidos sob os acrônimos: 
BI, DW (Datawarehouse) e cubos OLAP (online analytical processing)

informação, [algo que realmente agregue, aponte, antecipe, ou mesmo complemente] decisões é muito preciosa e deve ser obtida de forma rápida e exata.

Quando a questão é reunir 
informações de diferentes países, traduzindo-as nas 
estratégias e objetivos das suas respectivas companhias, os executivos têm deparado-se com um enorme desafio para a grande maioria deles, isso em todo o mundo. Não é difícil que os KPIs (Indicadores de Performance) definidos corporativamente não estejam alinhados com as suas estratégias.

A diversidade de 
bases de dados nas quais as informações se encontram são muito variáveis. O verdadeiro desafio ocorre no momento de consolidá-las em Dashboards e Scorecards por exemplo. Estas precisam ser reunidas de modo coerente e sucinto. 

No caso dos Balanced Scorecards (BSCs), estes oferecem aos executivos as ferramentas para atingirem o sucesso na obtenção de suas informações. Esta importante ferramenta sim, traduz a missão e a estratégia das suas empresas num conjunto abrangente de medidas de desempenho que servem como base para o sistema de medição e gestão estratégica, perseguindo os objetivos financeiros, incluindo os vetores de desempenho desses objetivos.

O grande dilema é: Mesmo cercado por dados de todas as origens, como posso obter informações relevantes para tomar minhas decisões?


Tags: André Luiz Bernardes, informação, dados, 
Análise, gerencial, executiva, financeira, balanço, faturamento, 
estimativa, CRM, SCM, KPI, BSC, MIS, BI,
Dashboard, Scorecard
relatório, gráfico,
reports, charts, MS, Microsoft, 
Office, Excel, Access, Word, Powerpoint, Outlook, sharepoint, Visio

Consultem à vontade:



André Luiz Bernardes
A&A® - Work smart, not hard.

         

LinkWithinBrazilVBAAccessSpecialist

Related Posts Plugin for WordPress, Blogger...

Vitrine