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:

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

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.

Sub Send()
    Dim Ws As Worksheet
    Dim Attachment As String
    
    Set Ws = ActiveSheet
    
    With Ws

        If Trim(.Range("ATTACHMENT")) = "" Then
            ThisWorkbook.Save
            ThisWorkbook.ChangeFileAccess xlReadOnly
            Attachment = ThisWorkbook.FullName
            ThisWorkbook.ChangeFileAccess xlReadWrite
        Else
            Attachment = .Range("ATTACHMENT")
        End If

        'CHECK WHETHER THE FUNCTION RETURNS TRUE OR FALSE
        If SendEmail(.Range("SENDER"), .Range("PASS"), .Range("RECIPIENT"), _
                  .Range("SUBJECT"), .Range("MESSAGE"), .Range("SMTP"), Attachment) = True Then
            MsgBox "Email was successfully sent to " & .Range("RECIPIENT") & ".", vbInformation, "Sending Successful"
        Else
            MsgBox "A problem has occurred while trying to send email.", vbCritical, "Sending Failed"
        End If

    End With

End Sub

FULL VBA CODE:

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

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

        If Attachment <> "" Then
            .AddAttachment Attachment
        End If
        
        On Error Resume Next
        err.Clear

        'SEND EMAIL
        .Send
    End With
    If err.Number = 0 Then
        SendEmail = True
    Else
        SendEmail = False
        Exit Function
    End If
    
End Function

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