Propósito

✔ Programação GLOBAL® - Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog devem ser tratados como consultoria freelance. Queiram contatar-nos: brazilsalesforceeffectiveness@gmail.com | ESTE BLOG NÃO SE RESPONSABILIZA POR QUAISQUER DANOS PROVENIENTES DO USO DOS CÓDIGOS AQUI POSTADOS EM APLICAÇÕES PESSOAIS OU DE TERCEIROS.

.: Vitrine

Carregando artigos...

Views

Mostrando postagens com marcador email. Mostrar todas as postagens
Mostrando postagens com marcador email. Mostrar todas as postagens

VBA Excel - Enviando emails via VBA - Send Email Using VBA


Um dos meios mais fáceis de automatizar o envio de e-mails através do MS Excel é invocar a função ObjectOutlook.Application.

Esta função devolve a referência ao objeto ActiveX, neste caso a aplicação Outlook, o qual é utilizado para a criação e o envio do  e-mail.

Copie e cole o código abaixo para que isso aconteça:

Sub EnvieMailVBA()
Dim Email_Subject, Email_Send_From, Email_Send_To, _
Email_Cc, Email_Bcc, Email_Body As String

Dim Mail_Object, Mail_Single As Variant

Let Email_Subject = "A&A: Enviando e-mail com VBA"
Let Email_Send_From = "<Digite o seu e-mail aqui>"
Let Email_Send_To = "<Digite o email para quem enviará>"
Let Email_Cc = "<Digite a pessoa para quem enviará a cópia deste email >"
Let Email_Bcc = "<Digite o email para quem enviará uma cópia oculta>"
Let Email_Body = "Parabéns!!!! O seu envio ocorreu com sucesso !!!!"

On Error GoTo debugs

Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)

With Mail_Single
Let .Subject = Email_Subject
Let .To = Email_Send_To
Let .cc = Email_Cc
Let .BCC = "bernardess@gmail.com" 'Email_Bcc
Let .Body = Email_Body

.send
End With

debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub


Como um lembrete: Quando enviar um e-mail usando este código VBA, uma janela pop-up alertando os usuários de que o "Um programa está tentando enviar automaticamente um email em seu nome. Você quer permitir isso? " aparece. 

Este é um aviso de segurança válido e não há nenhum trabalho direto ao redor dele. No entanto, existem outros dois meios pelos quais essa tarefa pode ser executada, uma através do uso de CDO e outro que simula a utilização do teclado.

Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...





Tags: VBA, Excel, e-mail, email, mail, send, objectoutlook.application, activeX

Nenhum comentário:
Tags: , , , , , , ,

VBA Excel - Enviando emails via CDO - Send Email Using CDO

O que é CDO?

É uma biblioteca de objetos que expõe as interfaces do Messaging Application Programming Interface (MAPI). 

O CDO permite que manipulemos os dados do Exchange para enviar e receber mensagens.

O uso do CDO pode ser preferível em casos onde gostaríamos de evitar a segurança pop-up que aparecem, tais como: "um programa está tentando enviar automaticamente um e-mail em seu nome", atrasando o nosso envio de e-mail até que o usuário forneça um resposta.

Neste exemplo usaremos a função CreateObject ("CDO.Message").

Um ponto importante a observar aqui é definir a configuração SMTP corretamente, de modo a evitar o temido "Erro em tempo de execução -2147220973 (80040213) " ou o " valor de configuração SendUsing erros é inválido "de aparecer.

Sub EnvieMail_CDO()
Dim CDO_Mail_Object As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim Email_Subject, Email_Send_From, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String

Let Email_Subject = "Enviando email via CDO"
Let Email_Send_From = "< Seu endereço de email >"
Let Email_Send_To = "< Endereço de email para envio >"
Let Email_Cc = "< Endereço de email de cópia >"
Let Email_Bcc = "< Endereço de email de cópia oculta >"
Let Email_Body = "Parabéns!!!! Seu envio através de CDO funcionou !!!!"

Set CDO_Mail_Object = CreateObject("CDO.Message")
On Error GoTo debugs

Set CDO_Config = CreateObject("CDO.Configuration")
CDO_Config.Load -1

Set SMTP_Config = CDO_Config.Fields

With SMTP_Config
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

' Coloque o nome do seu SERVIDOR abaixo:
Let .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "YOURSERVERNAME"

Let .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

.Update
End With

With CDO_Mail_Object
Set .Configuration = CDO_Config
End With

Let CDO_Mail_Object.Subject = Email_Subject
Let CDO_Mail_Object.From = Email_Send_From
Let CDO_Mail_Object.To = Email_Send_To
Let CDO_Mail_Object.TextBody = Email_Body
Let CDO_Mail_Object.cc = Email_Cc 'Use se achar necessário
Let CDO_Mail_Object.BCC = "bernardess@gmail.com" 'Use se achar necessário
'CDO_Mail_Object.AddAttachment FileToAttach 'Use se achar necessário
CDO_Mail_Object.send

debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub



Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...




Tags: VBA, Excel, e-mail, email, mail, send, CDO, SMTP, CreateObject, MAPI, 



Nenhum comentário:
Tags: , , , , , , , , ,

VBA Excel - Enviando emails usando Send Keys - Send Email Using Send Keys


Um outro modo de enviarmos um e-mail é por utilizarmos o comando ShellExecute para executar qualquer programa dentro do VBA. O comando ShellExecute pode ser usado para carregar um documento com um programa associado. Em essência, criamos um objeto string e o passamos como um parâmetro para a função ShellExecute. O resto do trabalho é feito pelo Windows. Ele decide automaticamente qual programa está associado a determinado tipo de documento.

Podemos usar a função ShellExecute para abrirmos o IExplorer, Word, Paintbrush e uma série de outras aplicações. 

A operação pode ser lenta e se não quiser executar o Send Keys antes mesmo do e-mail aparecer na tela e esperar alguns segundos, certifique-se que o envio do e-mail foi processos totalmente e, em seguida, ative o Send Keys. O envio precipitado impedirá que o email seja enviado.

Sub SendKeyMail()
Dim Mail_Object As String
Dim Email_Subject, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String

Email_Subject = "A&A: Enviando email via Keys"
Email_Send_To = " <Endereço de email para quem envia> "
Email_Cc = " <Endereço de email para quem deseja enviar cópia> "
Email_Bcc = " <Cópia oculta deste email> "
Email_Body = " Parabéns!!!! Seu email foi enviado !!!!"
Mail_Object = "mailto:" & Email_Send_To & "?subject=" & Email_Subject & "& body=" & Email_Body & "& cc=" & Email_Cc & "& bcc=" & Email_Bcc

On Error GoTo debugs

ShellExecute 0&, vbNullString, Mail_Object, vbNullString, vbNullString, vbNormalFocus

Application.Wait (Now + TimeValue("0:00:03"))

Application.SendKeys "%s"

debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub



Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...

Tags: VBA, Excel, e-mail, email, mail, send, send keys, ShellExecute, 




Nenhum comentário:
Tags: , , , , , , ,

VBA Excel - Enviando e-mail pelo Excel - Sending EMail With VBA



Sim, confesso ter escrito inúmeras vezes sob este tópico e, se continuo fazendo isso, é porque observo uma procura constante pela utilização deste recurso tão simples,mas tão necessário.

Se tudo o que deseja fazer é enviar a planilha, pode usar ThisWorkbook.SendMail. No entanto, se deseja incluir um texto no corpo da mensagem ou incluir arquivos adicionais como anexos, precisará de algum código VBA.

Procurei disponibilizar a função SendEmail por ser bem amigável.

Esse código prescinde da referência ao Microsoft CDO for Windows 2000 Library. Normalmente o localizamos em C:\Windows\system32\cdosys.dll. O GUID para este componente é {CD000000-8B95-11D1-82DB-00C04FB1625D}, para Maior = 1 e Menor = 0.

Function SendEMail (Subject As String, _
        FromAddress As String, _
        ToAddress As String, _
        MailBody As String, _
        SMTP_Server As String, _
        BodyFileName As String, _
        Optional Attachments As Variant = Empty) As Boolean
Dim MailMessage As CDO.Message
Dim N As Long
Dim FNum As Integer
Dim S As String
Dim Body As String
Dim Recips() As String
Dim Recip As String
Dim NRecip As Long

' ensure required parameters are present and valid.
If Len(Trim(Subject)) = 0 Then
    SendEMail = False
    Exit Function
End If

If Len(Trim(FromAddress)) = 0 Then
    SendEMail = False
    Exit Function
End If

If Len(Trim(SMTP_Server)) = 0 Then
    SendEMail = False
    Exit Function
End If

' Clean up the addresses
Recip = Replace(ToAddress, Space(1), vbNullString)
If Right(Recip, 1) = ";" Then
    Recip = Left(Recip, Len(Recip) - 1)
End If
Recips = Split(Recip, ";")

For NRecip = LBound(Recips) To UBound(Recips)
    On Error Resume Next
    ' Create a CDO Message object.
    Set MailMessage = CreateObject("CDO.Message")
    If Err.Number <> 0 Then
        SendEMail = False
        Exit Function
    End If
    Err.Clear
    On Error GoTo 0
    With MailMessage
        .Subject = Subject
        .From = FromAddress
        .To = Recips(NRecip)
        If MailBody <> vbNullString Then
            .TextBody = MailBody
        Else
            If BodyFileName <> vbNullString Then
                If Dir(BodyFileName, vbNormal) <> vbNullString Then
                    ' import the text of the body from file BodyFileName
                    FNum = FreeFile
                    S = vbNullString
                    Body = vbNullString
                    Open BodyFileName For Input Access Read As #FNum
                    Do Until EOF(FNum)
                        Line Input #FNum, S
                        Body = Body & vbNewLine & S
                    Loop
                    Close #FNum
                    .TextBody = Body
                Else
                    ' BodyFileName not found.
                    SendEMail = False
                    Exit Function
                End If
            End If ' MailBody and BodyFileName are both vbNullString.
        End If
        
        If IsArray(Attachments) = True Then
            ' attach all the files in the array.
            For N = LBound(Attachments) To UBound(Attachments)
                ' ensure the attachment file exists and attach it.
                If Attachments(N) <> vbNullString Then
                    If Dir(Attachments(N), vbNormal) <> vbNullString Then
                        .AddAttachment Attachments(N)
                    End If
                End If
            Next N
        Else
            ' ensure the file exists and if so, attach it to the message.
            If Attachments <> vbNullString Then
                If Dir(CStr(Attachments), vbNormal) <> vbNullString Then
                    .AddAttachment Attachments
                End If
            End If
        End If
        With .Configuration.Fields
            ' set up the SMTP configuration
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_Server
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With
        
        On Error Resume Next
        Err.Clear
        ' Send the message
        .Send
        If Err.Number = 0 Then
            SendEMail = True
        Else
            SendEMail = False
            Exit Function
        End If
    End With
Next NRecip
SendEMail = True
End Function

Caso deseje anexar algum objeto, adicione:

ThisWorkbook.Save
ThisWorkbook.ChangeFileAccess xlReadOnly

B = SendEmail( _
    ... parameters ...
    Attachments:=ThisWorkbook.FullName)
ThisWorkbook.ChangeFileAccess xlReadWrite

Tags: VBA, excel, Sending, EMail, CDO, Attachments, Workbook, mail, e-mail, 

Reference: CPerson

Nenhum comentário:
Tags: , , , , , , , ,

VBA Outlook - Envia uma cópia oculta automaticamente para um e-mail.

Inline image 1



O que é o fenômeno chamado BIG DATA?



Desenvolvermos um código que fique incubado no nosso MS Outlook para garantir que todos os e-mails que forem enviados através dele, automaticamente faça uma cópia deste conteúdo para outro endereço específico pode ser conseguido através da programação VBA.


Se você for menos experiente no uso de automação, talvez esteja se perguntando porque é que iria desejar implementar um código assim no seu MS Outlook.  É verdade que talvez não precise deste código agora, mas certamente o utilizará alguma vez na vida, reflita nas duas situações abaixo:

Digamos que deseje auditar todas as mensagens que estão sendo enviadas através do seu MS Outlook, recebendo uma cópia de qualquer mensagem que enviarem. Como fazer isso?

Quem sabe, queira guardar em uma conta de e-mail externa, o conteúdo de todos os e-mails enviados diariamente da sua máquina, através do MS Outlook, para garantir que nada se perca caso hajam problemas com o seu servidor local de e-mails, como fazer isso?


Private Sub Application_ItemSend (ByVal Item As Object, _
                                 Cancel As Boolean)
    '        Author: André Luiz Bernardes - bernardess@gmail.com
    '          Date: 05/08/13 - 16:03
    '   Application: OutlookFunctionalities®
    ' Functionality: Envia uma cópia oculta automaticamente para um e-mail.
    
    Dim objRecip As Recipient
    Dim strMsg As String
    Dim res As Integer
    Dim strBcc As String
    On Error Resume Next
    
    Let strBcc = "bernardess@gmail.com"

    Set objRecip = Item.Recipients.Add(strBcc)
    
    Let objRecip.Type = olBCC
    
    If Not objRecip.Resolve Then
        Let strMsg = "O Outlook não consegue enviar a mensagem para este endereço de e-mail BCC. " & _
                 "Deseja continuar enviando a mensagem?"
        Let res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                "Não consigo decifrar este endereço Bcc")
        
        If res = vbNo Then
            Let Cancel = True
        End If
    End If

    Set objRecip = Nothing
End Sub


brazilsalesforceeffectiveness@gmail.com

✔ Brazil SFE®Author´s Profile  Google+   Author´s Professional Profile   Pinterest   Author´s Tweets

Nenhum comentário:
Tags: , , , , , , ,

Extrair eMails



Consegue extrair um endereço de eMail de uma linha onde estejam contidos outros dados?

Veja o exemplo: 

André Luiz Bernardes <bernardess@gmail.com>

Utilize a função ExtractEmailAddress para extrair somente o endereço do e-mail.

Function ExtractEmailAddress(s As String) As String
    ' Author:                     Date:               Contact:
    ' André Bernardes             11/08/2008 09:01    bernardess@gmail.com
    ' Extrai apenas o e-mail de uma célula.

    Dim AtSignLocation As Long
    Dim i As Long
    Dim TempStr As String
    Const CharList As String = "[A-Za-z0-9._-]"

    'Localizando a @.
    Let AtSignLocation = InStr(s, "@")

    If AtSignLocation = 0 Then
        Let ExtractEmailAddress = "" 'not found
    Else
        Let TempStr = ""

        'Parte do e-mail antes da @.
        For i = AtSignLocation - 1 To 1 Step -1
            If Mid(s, i, 1) Like CharList Then
                Let TempStr = Mid(s, i, 1) & TempStr
            Else
                Exit For
            End If
        Next i

        If TempStr = "" Then Exit Function

        'Parte do e-mail depois da @.
        Let TempStr = TempStr & "@"

        For i = AtSignLocation + 1 To Len(s)
            If Mid(s, i, 1) Like CharList Then
                Let TempStr = TempStr & Mid(s, i, 1)
            Else
                Exit For
            End If
        Next i
    End If

    'Remove trailing period if it exists
    If Right(TempStr, 1) = "." Then _
       Let TempStr = Left(TempStr, Len(TempStr) - 1)

    Let ExtractEmailAddress = TempStr
End Function


Tags: VBA, Tips, UDF, e-mail, eMail,




Nenhum comentário:
Tags: , , , ,
Assinar: Postagens (Atom)
diHITT - Notícias