Send Email VBA

syedasadali

New Member
Joined
Mar 19, 2021
Messages
1
Office Version
  1. 2016
Platform
  1. Windows
I have the following code for sending the email in bulk, unfortunately, I'm unable to set the status as I need the status in Column "H" if the email sends then the status would be "sent" and if not send it could be updated as "Not Sent" Can anyone please help me in this to get the status of the sent emails?


Sub BulkMail()
Application.ScreenUpdating = False

ThisWorkbook.Activate
'Creating references to Application and MailItem Objects of Outlook
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem

'Creating variable to hold values of different items of mail
Dim sendTo, subj, atchmnt, msg, ccTo, bccTo As String

Dim lstRow As Long

'My data is on sheet "Exceltip.com" you can have any sheet name.

ThisWorkbook.Sheets("ToolforEmail").Activate
'Getting last row of containing email id in column 3.
lstRow = Cells(Rows.Count, 3).End(xlUp).Row

'Variable to hold all email ids

Dim rng As Range
Set rng = Range("C2:C" & lstRow)

'initializing outlook object to access its features
Set outApp = New Outlook.Application
On Error GoTo cleanup 'to handle any error during creation of object.

'Loop to iterate through each row, hold data in of email in variables and send 'mail to each email id.

For Each cell In rng
sendTo = Range(cell.Address).Offset(0, 0).Value2
subj = Range(cell.Address).Offset(0, 1).Value2 & "-MS"
msg = Range(cell.Address).Offset(0, 2).Value2
atchmnt = Range(cell.Address).Offset(0, -1).Value2
ccTo = Range(cell.Address).Offset(0, 3).Value2
bccTo = Range(cell.Address).Offset(0, 4).Value2

On Error Resume Next 'to hand any error during creation of below object
Set outMail = outApp.CreateItem(0)

'Writing and sending mail in new mail
With outMail
.To = sendTo
.cc = ccTo
.BCC = bccTo
.Body = msg
.Subject = subj
.Attachments.Add atchmnt
.Send 'this send mail without any notification. If you want see mail
'before send, use .Display method.
End With
On Error GoTo 0 'To clean any error captured earlier
Set outMail = Nothing 'nullifying outmail object for next mail
Next cell 'loop ends

cleanup: 'freeing all objects ceated
Set outApp = Nothing
Application.ScreenUpdating = True
Application.ScreenUpdating = True

MsgBox "Emails Sent", vbInformation

End Sub
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,623
Office Version
  1. 2007
Platform
  1. Windows
Hi and welcome to MrExcel.
Try this:

VBA Code:
Sub BulkMail()
  'Creating references to Application and MailItem Objects of Outlook
  Dim outApp As Outlook.Application
  Dim outMail As Outlook.MailItem
  Dim cell As Range
  Dim sendTo As String, subj As String, atchmnt As String
  Dim msg As String, ccTo As String, bccTo As String
  
  Application.ScreenUpdating = False
  
  ThisWorkbook.Activate
  ThisWorkbook.Sheets("ToolforEmail").Activate
  'initializing outlook object to access its features
  Set outApp = New Outlook.Application
  
  'Loop to iterate through each row, hold data in of email in variables and send 'mail to each email id.
  For Each cell In Range("C2", Range("C" & Rows.Count).End(3))
    sendTo = Range(cell.Address).Offset(0, 0).Value2
    subj = Range(cell.Address).Offset(0, 1).Value2 & "-MS"
    msg = Range(cell.Address).Offset(0, 2).Value2
    atchmnt = Range(cell.Address).Offset(0, -1).Value2
    ccTo = Range(cell.Address).Offset(0, 3).Value2
    bccTo = Range(cell.Address).Offset(0, 4).Value2
    
    On Error Resume Next 'to hand any error during creation of below object
    Set outMail = outApp.CreateItem(0)
    
    'Writing and sending mail in new mail
    With outMail
      .To = sendTo
      .cc = ccTo
      .BCC = bccTo
      .Body = msg
      .Subject = subj
      If atchmnt <> "" Then
        If Dir(atchmnt) <> "" Then .Attachments.Add atchmnt
      End If
      'before send, use .Display method.
      .Send 'this send mail without any notification. If you want see mail
      If Err.Number <> 0 Then
        Range("H" & cell.Row).Value = "Not Sent"
      Else
        Range("H" & cell.Row).Value = "Sent"
      End If
    End With
    'On Error GoTo 0 'To clean any error captured earlier
    Set outMail = Nothing 'nullifying outmail object for next mail
  Next cell 'loop ends
  
  Set outApp = Nothing
  Application.ScreenUpdating = True
  MsgBox "Emails Sent", vbInformation
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,130,342
Messages
5,641,592
Members
417,224
Latest member
llama9207

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top