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 Mail. Mostrar todas as postagens
Mostrando postagens com marcador Mail. 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 Tips - Enviando e-mail com código VBA - Send From GMail





Baixe o Calendário Compacto para 2014 em Excel



O que é o fenômeno chamado BIG DATA?




O endereço do servidor de SMTP do GMail é "smtp.gmail.com". Este servidor requer conexões SSL ou TLS, e através destes poderemos enviar emails através da autenticação ESMTP. Por exemplo, digamos que o seu email seja "bernardess@gmail.com", e o seu nome de usuário seja "bernardess@gmail.com".

Note que:


- O exemplo a seguir demonstra um código através do qual poderá enviar mensagens de email através do servidor de SMTP do GMail.


- Para implementar completamente este projeto, certifique-se de baixar e instalar o programa EASendMail na sua máquina.


- Para rodar o projeto corretamente, lembre-se de configurá-lo corretamente, mude o Servidor SMTP, o usuário, a senha, o destino, etc...


Divirta-se:

Private Sub btnSendMail_Click() 

    Dim oSmtp As New EASendMailObjLib.Mail 


    Let oSmtp.LicenseCode = "TryIt" 


    ' Set your Gmail email address

    Let oSmtp.FromAddr = "bernardess@gmail.com" 


    ' Add recipient email address

    oSmtp.AddRecipientEx "bernardess@gmail.com", 0 


    ' Set email subject

    Let oSmtp.Subject = "test email from gmail account" 


    ' Set email body

    Let oSmtp.BodyText = "this is a test email sent from VB 6.0 project with gmail" 


    ' Gmail SMTP server address

    Let oSmtp.ServerAddr = "smtp.gmail.com" 


    ' If you want to use direct SSL 465 port,

    ' Please add this line, otherwise TLS will be used.

    ' oSmtp.ServerPort = 465


    ' detect SSL/TLS automatically

    oSmtp.SSL_init 


    ' Gmail user authentication should use your

    ' Gmail email address as the user name.

    ' For example: your email is "bernardess@gmail.com", then the user should be "bernardess@gmail.com"


    Let oSmtp.UserName = "bernardess@gmail.com" 

    Let oSmtp.Password = "SUA SENHA" 


    MsgBox "start to send email ..." 


    If oSmtp.SendMail() = 0 Then 

        MsgBox "email was sent successfully!" 

    Else 

        MsgBox "failed to send email with the following error:" & oSmtp.GetLastErrDescription() 

    End If 


End Sub 


E sim, temos uma outra versão para você explorar:


'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

'>>> Database by Tony Hine, alias Uncle Gizmo                                 <<<
'>>> Created Mar, 2011                                                        <<<
'>>> Last up-dated Mar, 2011                                                  <<<
'>>> Telephone International: +44 1635 522233                                 <<<
'>>> Telephone UK: 01635 533322                                               <<<
'>>> e-mail: email@tonyhine.co.uk                                             <<<
'>>> Skype: unclegizmo                                                        <<<
'>>> I post at the following forum (mostly) :                                 <<<
'>>> http://www.access-programmers.co.uk/forums/  (alias Uncle Gizmo)         <<<
'>>> You can also find me on the Ecademy: http://www.ecademy.com/user/tonyhine<<<
'>>> try this website: http://www.tonyhine.co.uk/example_help.htm             <<<
'>>> I have now started a forum which contains video instructions here:       <<<
'>>> http://msAccessHintsAndTips.Ning.Com/                                    <<<
'>>> CODE SUPPLIED NOT CHECKED AND TESTED FOR ERRORS!!!! Be Warned            <<<
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Public Function fSendGmail (ByVal sTo As String, ByVal sEmail As String, ByVal sPass As String, _
    ByVal strMsg As String, ByVal strSubject As String) As Boolean 'Returns True if No Errors

On Error GoTo Err_ErrorHandler
fSendGmail = True

'Extract
'This basic example sends a simple, no-frills text message every time the script is run:            '
'Example File script0603.vbs                                                                        '

'Extract
'The SendMail() Function
'While longer, SendMail( ) is itself a simpler function than GetData( ) . It simply creates three   '
'objects: CDO. Message, CDO. Configuration, and a subobject of CDO. Configuration called            '
'Fields . The Scripting library used in GetData() is a default part of the ASP namespace, and       '
'therefore any new object created in the Scripting library is known. To use objects in the CDO      '
'library, the METADATA statements at the top of the ASP page are necessary.                         '

'Standard CDO Constants
'NOTE --- If you set conCdoSmtpUseSSL to True, you may need to set conCdoSendUsingPort to 465 or port number specified by your ISP.
Const conStrPrefix As String = "http://schemas.microsoft.com/cdo/configuration/"
Const conCdoSendUsingPort As Integer = 2    'If incorrect raises this Error: -2147220960
'Const conSendPassword As String = "YourGmailPasswordHere"
Const conCdoBasic As Integer = 1
'Const conSendUserName As String = "YourGmailAddrHere@gmail.com"
Const conStrSmtpServer As String = "smtp.gmail.com"     'If incorrect raises this Error: -2147220973
Const conCdoSmtpUseSSL As Boolean = True    'Use Secure Sockets Layer (SSL) when posting via SMTP.
Const conCdoSmtpServerPort As Integer = 465 'Can be 465 or 587 'If incorrect raises this Error: -2147220973

Dim oMsg As Object
Dim oConf As Object

Dim strEmailAddr As String
'CHANGE THIS!!
'strEmailAddr = sTo & ""

'Create Objects
Set oMsg = CreateObject("CDO.Message")
Set oConf = CreateObject("CDO.Configuration")
Set oMsg.Configuration = oConf

'Build the Message
With oMsg
    .To = "" & sTo       'If incorrect you will get an email From: Delivery Status Notification (Failure) Delivery to the following recipient failed permanently:
    .From = "Grievance Tracker <" & sEmail & ">"    'If incorrect raises this Error: -2147220973
    .Subject = strSubject
    .textBody = strMsg
    '.AddAttachment "H:\ATHDrive\ATH_Programming\ATH_Office\Access2007\My_MS_Access_Tools\GoogleEmail\TransscriptGmailFromVBA.txt"
End With
            
''Set Delivery Options
            With oConf.Fields
                .Item(conStrPrefix & "sendusing") = conCdoSendUsingPort
                .Item(conStrPrefix & "smtpserver") = conStrSmtpServer
                .Item(conStrPrefix & "smtpauthenticate") = conCdoBasic
                .Item(conStrPrefix & "sendusername") = sEmail
                .Item(conStrPrefix & "sendpassword") = sPass
                '.Item(conStrPrefix & "sendusername") = conSendUserName 'IF you want to hard code the username you can reactivate this line.
                '.Item(conStrPrefix & "sendpassword") = conSendPassword 'IF you want to hard code the password you can reactivate this line.
                .Item(conStrPrefix & "smtpusessl") = conCdoSmtpUseSSL
                .Item(conStrPrefix & "smtpserverport") = conCdoSmtpServerPort
                .Update 'Commit Changes
            End With

'Deliver the Message
oMsg.Send

Exit_ErrorHandler:
'Access 2007 Developer Reference > Microsoft Data Access Objects (DAO) Reference > DAO Reference > Recordset Object > Methods
'An alternative to the Close method is to set the value of an object variable to Nothing (Set dbsTemp = Nothing).
    Set oMsg.Configuration = Nothing
    Set oConf = Nothing
    Set oMsg = Nothing
    Exit Function

Err_ErrorHandler:
    If Err.Number <> 0 Then fSendGmail = False
        Select Case Err.Number

            Case -2147220977  'Likely cause, Incorrectly Formatted Email Address, server rejected the Email Format
                MsgBox "Error From --- fSendGmail --- Incorrectly Formatted Email ---  Error Number >>>  " _
                & Err.Number & "  Error Desc >>  " & Err.Description, , "Format the Email Address Correctly"

            Case -2147220980  'Likely cause, No Recipient Provided (No Email Address)
                MsgBox "Error From --- fSendGmail --- No Email Address ---  Error Number >>>  " _
                & Err.Number & "  Error Desc >>  " & Err.Description, , "You Need to Provide an Email Address"

            Case -2147220960 'Likely cause, SendUsing Configuration Error
                MsgBox "Error From --- fSendGmail --- The SendUsing configuration value is invalid --- LOOK HERE >>> sendusing) = conCdoSendUsingPort ---  Error Number >>>  " _
                & Err.Number & "  Error Desc >>  " & Err.Description, , "SendUsing Configuration Error"
            
            Case -2147220973  'Likely cause, No Internet Connection
                MsgBox "Error From --- fSendGmail --- No Internet Connection ---  Error Number >>>  " _
                & Err.Number & "  Error Desc >>  " & Err.Description, , "No Internet Connection"
            
            Case -2147220975  'Likely cause, Incorrect Password
                MsgBox "Error From --- fSendGmail --- Incorrect Password ---  Error Number >>>  " _
                & Err.Number & "  Error Desc >>  " & Err.Description, , "Incorrect Password"
            
            Case Else   'Report Other Errors
                MsgBox "Error From --- fSendGmail --- Error Number >>>  " & Err.Number _
                & "  <<< Error Description >>  " & Err.Description
        End Select
        
    Resume Exit_ErrorHandler
End Function      'fSendGmail


Tags: VBA. GMail, e-mail, mail, send, SMTP, SSL, TLS, ESMTP, CDO, 






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