Send mass emails from Excel

Question

I have a workbook with sheets like so [data 1, data 2, data 3, sheet 1, sheet 2, sheet 3 ... sheet 20]. data 1-3 sheets are data sources. sheet 1-20 are template sheets that use these data sources to generate "reports".
What I want to achieve is to send all these reports at once from Excel without having to export them to bitmap and then copying them to email. data 1 sheet has all the emails corresponding to each sheet, like so:
sheet 1 ----- name ----- email
sheet 2 ----- name ----- email
.
.
.
sheet 20 ----- name ----- email

Here's a pseudo code of what I'm trying achieve (this is the best way I understand things)

for sheets 1-20:
    create tmp_email(object)
    tmp_email.subject = name+" report" #this name is from the data 1, the corresponding name for this sheet
    text_1 = "dear "+name+", here is your report"
    report_img = img_export($A$1:$P$149) #this is the area in all the template sheets that is exported into bitmap image
    text_2 = "best regards"
    tmp_email.body = text_1 + report_img + text_2
    tmp_email.send(email) #this email is from the data 1, the corresponding email for this sheet

Hopefully this makes sense. So all I have to do is build my sheets 1 - 20, which are autogenerated and then they are automatically sent.

Answer 1

Here are three ways you can send a email through outlook (tested works 11.29.18) (no email popups done in the backround)

Send via CDO:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub Send_Email_Using_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

Email_Subject = "Trying to send email using CDO"
Email_Send_From = "databison@gmail.com"
Email_Send_To = "databison@gmail.com"
Email_Cc = "databison@gmail.com"
Email_Bcc = "databison@gmail.com"
Email_Body = "Congratulations!!!! You have successfully sent an e-mail using CDO !!!!"

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
            'Put your server name below
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "YOURSERVERNAME"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With

With CDO_Mail_Object
    Set .Configuration = CDO_Config
End With

CDO_Mail_Object.Subject = Email_Subject
CDO_Mail_Object.From = Email_Send_From
CDO_Mail_Object.To = Email_Send_To
CDO_Mail_Object.TextBody = Email_Body
CDO_Mail_Object.cc = Email_Cc                      'Use if needed
CDO_Mail_Object.BCC = Email_Bcc                    'Use if needed
'CDO_Mail_Object.AddAttachment FileToAttach        'Use if needed
CDO_Mail_Object.send

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

send via keys:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

'***********************************************************************
'~~~~~~~~~~~~~~~~~~CODE COURTESY :: WWW.OZGRID.COM~~~~~~~~~~~~~~~~~~~~~~
'***********************************************************************
Sub Send_Email_Using_Keys()
    Dim Mail_Object As String
    Dim Email_Subject, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String

    Email_Subject = "Trying to send email using Keys"
    Email_Send_To = "databison@gmail.com"
    Email_Cc = "databison@gmail.com"
    Email_Bcc = "databison@gmail.com"
    Email_Body = "Congratulations!!!! You have successfully sent an e-mail using Keys !!!!"

    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:02"))
    Application.SendKeys "%s"

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

send via VBA:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub Send_Email_Using_VBA()
Dim Email_Subject, Email_Send_From, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant

Email_Subject = "Trying to send email using VBA"
Email_Send_From = "databison@gmail.com"
Email_Send_To = "databison@gmail.com"
Email_Cc = "databison@gmail.com"
Email_Bcc = "databison@gmail.com"
Email_Body = "Congratulations!!!! You have successfully sent an e-mail using VBA !!!!"

On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
    .Subject = Email_Subject
    .To = Email_Send_To
    .cc = Email_Cc
    .BCC = Email_Bcc
    .Body = Email_Body
    .send
End With

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

to send the active workbook:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

'***********TO SEND THE ACTIVE WORKBOOK************'
Sub Send_Active_Workbook_Using_VBA()
Dim Email_Send_To, Email_Subject  As String

Email_Subject = "Trying to send email with the workbook as attachment"
Email_Send_To = "databison@gmail.com"

ActiveWorkbook.SendMail Recipients:=Email_Send_To, Subject:=Email_Subject
End Sub

Creating buttons to send emails:

Private Sub CommandButton1_Click()
Sheet1.Send_Email_Using_VBA
End Sub

Private Sub CommandButton2_Click()
Sheet1.Send_Email_Using_CDO
End Sub

Private Sub CommandButton3_Click()
Sheet1.Send_Email_Using_Keys
End Sub