VBA - Outlook to send email

[gd6noob]

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.

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

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
	A	B	C	D	E	F	G
1	To	CC	BCC	Subject	Name	Body	Attachment
2				Test Mass Email			Email template.pptx
3
Mass Email

 

[6StringJazzer]

1. Remove or comment out this line.

                    .Display

2. Add this code around your existing For loop:

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

 

[gd6noob]

1. Remove or comment out this line.

                    .Display

2. Add this code around your existing For loop:

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...

 

[6StringJazzer]

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.

 

[gd6noob]

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...