VBA - Outlook to send email

gd6noob

Board Regular
Joined
Oct 20, 2017
Messages
170
Office Version
  1. 2016
Platform
  1. Windows
Hi guys,

I have a couple questions. I have spreadsheet that runs different code. 1 code if you sending to a single email and another if your sending mass emails. I could have probably just stick with 1 but its ok.

Question:
  1. How can I send the email without having excel show the outlook mail before sending? I thought by having ".send" it would work but it does not seem to work. This is annoying to see when Im sending bulk emails to hundreds of people in my workplace.
  2. For the Bulkmail code, how can I display a message indicated "Row 1 of X completed" so that I know how far along it is.

Thank you in advanced.

VBA Code:
Sub SingleMail()
Application.ScreenUpdating = False

ThisWorkbook.Activate
'Creating references to Application and MailItem Objects of Outlook
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim wd As Word.Application
Dim doc As Word.Document
Dim oAccount As Outlook.Account
Dim path As String
path = Application.ActiveWorkbook.path
'Creating variable to hold values of different items of mail
Dim sendTo, subj, atchmnt, msg, ccTo, bccTo As String

Set wd = CreateObject("Word.Application")
    wd.Visible = False
Set doc = wd.Documents.Open(Filename:=path + "\" & Sheets("Dashboard").Range("G32"), ReadOnly:=True)
    doc.Content.Copy

ThisWorkbook.Sheets("Dashboard").Activate

For Each oAccount In Outlook.Application.Session.Accounts

If oAccount = Sheets("Dashboard").Range("G22") Then


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

 
            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 = Range("G7")
                .CC = Range("G12")
                .BCC = Range("G17")
                .Subject = Range("G27")
                .BodyFormat = olFormatRichText
                    Set Editor = .GetInspector.WordEditor
                    Editor.Content.Paste
                    .Display
                .Attachments.Add (path + "\" & Sheets("Dashboard").Range("G37"))
                .SendUsingAccount = oAccount 'this send mail without any notification. If you want see mail
                .Send     '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
End If
Next
cleanup: 'freeing all objects created
    wd.Quit
    Set outApp = Nothing
    Set wd = Nothing
    Set doc = Nothing
    Set oAccount = Nothing
    Set sendTo = Nothing
    Set subj = Nothing
    Set atchmnt = Nothing
    Set msg = Nothing
    Set ccTo = Nothing
MsgBox "Emails sent"

Application.ScreenUpdating = True

End Sub


VBA Code:
Sub BulkMail()
Application.ScreenUpdating = False

Sheet1.Activate
'Creating references to Application and MailItem Objects of Outlook
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim wd As Word.Application
Dim doc As Word.Document
Dim oAccount As Outlook.Account
Dim path As String
path = Application.ActiveWorkbook.path

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

Set wd = CreateObject("Word.Application")
    wd.Visible = False
Set doc = wd.Documents.Open(Filename:=path + "\" & Sheets("Dashboard").Range("G32"), ReadOnly:=True)
    doc.Content.Copy
'My data is on sheet "Exceltip.com" you can have any sheet name.

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

For Each oAccount In Outlook.Application.Session.Accounts

If oAccount = Sheets("Dashboard").Range("G22") Then

'Variable to hold all email ids

Dim rng As Range
Set rng = Range("A2:A" & 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
            ccTo = Range(cell.Address).Offset(0, 1).Value2
            bccTo = Range(cell.Address).Offset(0, 2).Value2
            subj = Range(cell.Address).Offset(0, 3).Value2
            msg = Range(cell.Address).Offset(0, 5).Value2
            atchmnt = path + "\" & Sheets("Mass Email").Range(cell.Address).Offset(0, 6).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
                .Subject = subj
'                .Body = rngBody.Value   'commented out to send DOC as body
                .BodyFormat = olFormatRichText
                    Set Editor = .GetInspector.WordEditor
                    Editor.Content.Paste
                    .Display
                .Attachments.Add atchmnt
                .SendUsingAccount = oAccount 'this send mail without any notification. If you want see mail
                .Send     '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
End If
Next
cleanup: 'freeing all objects created
    wd.Quit
    Set outApp = Nothing
    Set wd = Nothing
    Set doc = Nothing
    Set oAccount = Nothing
    Set sendTo = Nothing
    Set subj = Nothing
    Set atchmnt = Nothing
    Set msg = Nothing
    Set ccTo = Nothing
MsgBox "Emails sent"

Application.ScreenUpdating = True

End Sub

Email.xlsb
ABCDEFG
1ToCCBCCSubjectNameBodyAttachment
2Test Mass EmailEmail template.pptx
3
Mass Email
 
Last edited:

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
1. Remove or comment out this line.
VBA Code:
                    .Display

2. Add this code around your existing For loop:

VBA Code:
Dim Count As Long
...
        For Each cell In rng
            Count = Count + 1
            Application.StatusBar = "Sending #" & Count
...
        Next cell ' loop ends
        Application.StatusBar = False
 
Upvote 0
1. Remove or comment out this line.
VBA Code:
                    .Display

2. Add this code around your existing For loop:

VBA Code:
Dim Count As Long
...
        For Each cell In rng
            Count = Count + 1
            Application.StatusBar = "Sending #" & Count
...
        Next cell ' loop ends
        Application.StatusBar = False

#1 - I tried .display, but it only sends a blank email. This causes the doc not to paste in the email body.

#2 - There was a compile error when I put it around... so I put in inside the existing loop and it worked.. thanks...
 
Upvote 0
I'm not following the issues. For #1, I said to remove .Display. That is what causes the email to be visible to the user. You can do anything you want to the email without having to display it. For #2, I showed exactly what the code should look like relative to your existing code. There is nothing that would cause a compile error. If you figured out something that works then I guess it doesn't matter.
 
Upvote 0
I'm not following the issues. For #1, I said to remove .Display. That is what causes the email to be visible to the user. You can do anything you want to the email without having to display it. For #2, I showed exactly what the code should look like relative to your existing code. There is nothing that would cause a compile error. If you figured out something that works then I guess it doesn't matter.
Sorry, I meant to say I tried comment out .display

Sometimes what I think in my head sometimes doesnt get typed out...
 
Upvote 0

Forum statistics

Threads
1,223,897
Messages
6,175,270
Members
452,628
Latest member
dd2

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
Back
Top