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:
Thank you in advanced.
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:
- 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.
- 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 | |||||||||
---|---|---|---|---|---|---|---|---|---|
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 |
Last edited: