Send Email with Excel VBA via CDO through GMail

If you're working on a project or having a numerous reports in excel to be sent out to your boss or clients. And what you usually do is save the workbook, compose a new email, copy the contents or attach it on your email client. That's a time consuming task!

What we wanted to do is automate the tasks from within the Excel Workbook you're working with. The SendEmail() Function below will do the task for you.

Function Definition:

?

1

Function SendEmail(ByVal Username As String, _<br>                   ByVal Password As String, _<br>                   ByVal ToAddress As String, _<br>                   ByVal Subject As String, _<br>                   ByVal HTMLMessage As String, _<br>                   ByVal SMTPServer As String, _<br>                   Optional Attachment As Variant = Empty) As Boolean<br>

Paramaters:

• Username - is the email address of the sender.
• Password - is the password of the sender.
• ToAddress - is the recipient of email to which the email be sent. Multiple email addresses can be separated with semi-colons.
• Subject - is the subject of the email.
• HTMLMessage - may contain both plain text and html message. 
• SMTPServer - is the name of the outgoing email server. If you're connected within a company's intranet you can use your company's outgoing email server. In this tutorial we'll be using gmail's smtp server.
• Attachment - is the file name that will be attached to the message. If you're going to send the workbook that you're working with as an attachment, you can just put ThisWorkbook.FullName.

Requirement:
This function requires you to add a reference to Microsoft CDO for Windows 2000. At Microsoft Visual Basic Interface go to Tools>References...

CONFIG SETUP:
You may also create another sheet for the configuration setup and assign names to ranges or fields.

USAGE:
You can call the function via a click of a button or when a target is changed on a worksheet.

?

1

Sub Send()<br>    Dim Ws As Worksheet<br>    Dim Attachment As String<br>    <br>    Set Ws = ActiveSheet<br>    <br>    With Ws<br><br>        If Trim(.Range("ATTACHMENT")) = "" Then<br>            ThisWorkbook.Save<br>            ThisWorkbook.ChangeFileAccess xlReadOnly<br>            Attachment = ThisWorkbook.FullName<br>            ThisWorkbook.ChangeFileAccess xlReadWrite<br>        Else<br>            Attachment = .Range("ATTACHMENT")<br>        End If<br><br>        'CHECK WHETHER THE FUNCTION RETURNS TRUE OR FALSE<br>        If SendEmail(.Range("SENDER"), .Range("PASS"), .Range("RECIPIENT"), _<br>                  .Range("SUBJECT"), .Range("MESSAGE"), .Range("SMTP"), Attachment) = True Then<br>            MsgBox "Email was successfully sent to " & .Range("RECIPIENT") & ".", vbInformation, "Sending Successful"<br>        Else<br>            MsgBox "A problem has occurred while trying to send email.", vbCritical, "Sending Failed"<br>        End If<br><br>    End With<br><br>End Sub<br>

FULL VBA CODE:

?

1

Function SendEmail(ByVal Username As String, _<br>                   ByVal Password As String, _<br>                   ByVal ToAddress As String, _<br>                   ByVal Subject As String, _<br>                   ByVal HTMLMessage As String, _<br>                   ByVal SMTPServer As String, _<br>                   Optional Attachment As Variant = Empty) As Boolean<br><br>    Dim Mail As New Message<br>    Dim Cfg As Configuration<br>    <br>    'CHECK FOR EMPTY AND INVALID PARAMETER VALUES<br>    If Trim(Username) = "" Or _<br>        InStr(1, Trim(Username), "@") = 0 Then<br>        SendEmail = False<br>        Exit Function<br>    End If<br>    <br>    If Trim(Password) = "" Then<br>        SendEmail = False<br>        Exit Function<br>    End If<br>    <br>    If Trim(Subject) = "" Then<br>        SendEmail = False<br>        Exit Function<br>    End If<br>    <br>    If Trim(SMTPServer) = "" Then<br>        SendEmail = False<br>        Exit Function<br>    End If<br>    <br>    <br>    On Error Resume Next<br>    Set Cfg = Mail.Configuration<br>    <br>    'SETUP MAIL CONFIGURATION FIELDS<br>    Cfg(cdoSendUsingMethod) = cdoSendUsingPort<br>    Cfg(cdoSMTPServer) = SMTPServer<br>    Cfg(cdoSMTPServerPort) = 25<br>    Cfg(cdoSMTPAuthenticate) = cdoBasic<br>    Cfg(cdoSMTPUseSSL) = True<br>    Cfg(cdoSendUserName) = Username<br>    Cfg(cdoSendPassword) = Password<br>    Cfg.Fields.Update<br>    <br>    If err.Number <> 0 Then<br>        SendEmail = False<br>        Exit Function<br>    End If<br>    err.Clear<br>    <br>    On Error GoTo 0<br>    With Mail<br>        .From = Username<br>        .To = ToAddress<br>        .Subject = Subject<br>        .HTMLBody = HTMLMessage<br><br>        If Attachment <> "" Then<br>            .AddAttachment Attachment<br>        End If<br>        <br>        On Error Resume Next<br>        err.Clear<br><br>        'SEND EMAIL<br>        .Send<br>    End With<br>    If err.Number = 0 Then<br>        SendEmail = True<br>    Else<br>        SendEmail = False<br>        Exit Function<br>    End If<br>    <br>End Function<br>

RESULTS:
Below are the results after running the above code snippet.