Use VBA to send mass email - excel

I'm taking over a workbook created from the last employee. There's a specific coding that I cannot figure out where it states to grab the email list from to plug into the BCC line.
I'm not finding anywhere in the code that states that but the macro somehow works. It is able to extract the email addresses and plug them into the bcc line on the email template. I see that they specified bc_r but I don't see any worksheets name RecipientEmails. The only worksheet with a list of email addresses in this workbook that I see is in the same tab as the command button to pull this email template. The email address is listed on this sheet under column T. So, I'm unsure why the code says c1. Please review the codes below and if you can guide me, I'd appreciate it.
Sub esendemail()
Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object
Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)
bc_r = ""
For Each c1 In Range("RecipientEmails")
bc_r = bc_r & ";" & c1.Value
Next c1
With newEmail
.To = ""
.BCC = bc_r
.Subject = "Welcome to the team!"
.Body = "[Greetings]" & vbCrLf & " " & vbCrLf & "Practice Name:"
.Display
Set xInspect = newEmail.GetInspector
Set pageEditor = xInspect.WordEditor
Set pageEditor = Nothing
End With
Set newEmail = Nothing
Set outlook = Nothing
End Sub

The email addresses are retrieved in the named range:
bc_r = ""
For Each c1 In Range("RecipientEmails")
bc_r = bc_r & ";" & c1.Value
Next c1
Check out the RecipientEmails named range in your worksheet. See Create a named range from selected cells in a worksheet for more information about named ranges.
Also I'd recommend using the Recipients property for setting up recipients on the Outlook item. You can read more about that approach in the article I wrote for the technical blog, see How To: Fill TO,CC and BCC fields in Outlook programmatically for more information.

Related

Convert from sending email immediately from Excel to displaying in Outlook

In this code an Excel file table from active sheet is sent directly via email.
I need to change it to same result only difference is I need it open in Outlook as draft and not send it (there will be added more of text etc.).
I tried .Display but it won't open Outlook new email, it is displayed in Excel.
Sub Send()
Dim AWorksheet As Worksheet
Dim Sendrng As Range
Dim rng As Range
On Error GoTo StopMacro
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Fill in the Worksheet/range you want to mail
'Note: if you use one cell it will send the whole worksheet
Set Sendrng = Range("B1:M44")
'Remember the activesheet
Set AWorksheet = ActiveSheet
With Sendrng
' Select the worksheet with the range you want to send
.Parent.Select
'Remember the ActiveCell on that worksheet
Set rng = ActiveCell
'Select the range you want to mail
.Select
' Create the mail and send it
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
' Set the optional introduction field thats adds
' some header text to the email body.
.Introduction = "Dear All," & vbNewLine & vbNewLine & "Please find XXX."
With .Item
.To = "XXXX"
.Subject = "XXX"
.Send
End With
End With
'select the original ActiveCell
rng.Select
End With
'Activate the sheet that was active before you run the macro
AWorksheet.Select
StopMacro:
With Application
Replace .Send with .Display. If you want to wait for the user to either click on the Send button or dismiss the message, use .Display(true) to show it modally.
You can automate Outlook directly from an Excel macro where you could display a new mail item to a user. For example, the following code creates a new mail items, set up properties on the item and then display it for a user:
variables declared as a specific object type ie. specific to the application which is being automated:
Dim applOL As Outlook.Application
Dim miOL As Outlook.MailItem
'Create a new instance of the Outlook application. Set the Application object as follows:
Set applOL = New Outlook.Application
'create mail item:
Set miOL = applOL.CreateItem(olMailItem)
With miOL
.To = "info#test.com"
.CC = ""
.Importance = olImportanceLow
.Subject = "Mail Automation"
.Body = "Sending the Active Excel Workbook as attachment!"
'add host workbook as an attachment to the mail:
.Attachments.Add ActiveWorkbook.FullName
.ReadReceiptRequested = True
.Display
End With
'clear the object variables:
Set applOL = Nothing
Set miOL = Nothing
Don't forget to add an Outlook COM reference to your VBA project in Excel. See Automating Outlook from a Visual Basic Application for more information.

Sending an Email with VBA Based on Address from Specific Cell In a Filtered Table

This may sound similar to other posts on StackFlow, but it is not. I could not find a thread targeting this issue.
Every month, I reach out to custodians concerning accounts I manage. I have a sheet that contains a table with all the accounts and their respective custodians in a single table. I filter by column E, and based on the custodian, I copy and paste the table with the information related to the respective custodian in the body of the email. This is a tedious process, so I attempted to create a macro that prepares and formats the email to my liking.
There is just one issue. If you take a look at the logic below the email address used is pulled from the email address located in column F. My initial thought was to filter the custodian I want, and when I press the button to trigger the macro, it would search the first cell in column F (F2) and inserts in the "To" field in the email. So, if I choose Bank of America, it works great because the email is in cell F2, and the Macro pulls that email correctly. The problem occurs when I filter for a different custodian. I thought the macro will look in that same area and pull the proper email address for the specific custodian. Because I filter the table, the custodian I am filtering is essentially in another cell, so it does not pull from what I filtered by. For example, let's say I filter for State Street in column E, despite the table looking like it is in the same place as Bank of America it is essentially in F22, so the macro does not pull the email for State Street. It instead pulls the email address for Bank of America in cell F2. Is there a way to direct the macro to look in the area rather than the specific cell reference to pull the email I want to send to thus limiting the issue if I filter the table?
Private Sub CommandButton1_Click()
Dim Sht As Excel.Worksheet
Set Sht = ThisWorkbook.ActiveSheet
Recip = [F2].Value & "; " ' <-- !
Dim rng As Range
Set rng = Sht.Range("A2:F26")
rng.Copy
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object
Set OutMail = OutApp.CreateItem(0)
Dim vInspector As Object
Set vInspector = OutMail.GetInspector
Dim wEditor As Object
Set wEditor = vInspector.WordEditor
With OutMail
.TO = Recip
.CC = ""
.Subject = "STIF Vehicle Confirmation" & " - " & [E2].Value ' <-- !
.display
wEditor.Paragraphs(1).Range.Text = "Hello All," & Chr(11) & Chr(11) & "I hope this email finds you all doing well." & Chr(11) & Chr(11) & _
"Can you please confirm if the below STIF vehicle details are accurate for the accounts below? If the vehicle has changed, can you please confirm the new STIF vehicle name and CUSIP?" & vbCrLf
wEditor.Paragraphs(2).Range.Paste
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Macros to Send attach different files to multiple individual emails, vba

I am a computer technician, not a programmer, but in my new job I have been asked to finish a macros in excel (vba).
It consists of a list of id card numbers in one of the columns (the number of cells is variable each time it is used, one day you can put 20 people and another 12 for example), and emails in another column.
In a folder there are some pdf documents whose name is the id card of the person that appears in the excel.
What they ask me is that, being ordered the id card in alphabetical order, take the id card and email. The id card will serve to find your corresponding pdf and add it as an attachment with the idea of sending it by email, to whom? there the cell is used with the email data. This has to be done with each of the existing rows, take pdf file to attach it and send email to the address of that same row until there are no more rows on the sheet.
Can someone tell me how to do that or tell me the functions I need?
Thank you.
Graphical idea:
The macro is currently set to .Display the email and not send. After you have finished running tests you will want to change this to .Send to actually send the email.
You will also need to update the value of strLocation. Inside the quotes is where you will need to put the location of the folder that houses all of your target PDFs.
The order of your cells doesn't matter here as long as each row is associated to one individual.
Hopefully these emails are internal - you should not use this for external mailing lists as you cannot offer the option to unsubscribe. Outlook may flag/ban your account if you are suspected of spam.
This assumes the values in Column C are actual email addresses that will be recognized as is by Outlook. (urdearboy#email.com)
Sub CorpCard()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*#?*.?*" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.SentOnBehalfOfName = "[your associated Outlook email here]"
.to = cell.Value
.Subject = "Subject goes here"
.Body = "Hi " & Range("B" & cell.Row).Value & "," _
'Body to be patsed here
strLocation = "C:\Users\urdearboy\Desktop\File Name\" & Cells(cell.Row, "D").Value & ".pdf"
.Attachments.Add (strLocation)
.Display
'.Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

MailItem.GetInspector.WordEditor in Office 2016 generates Application-defined or object defined error

I wrote an Excel macro to send email from a spreadsheet. It works on Office 2013, but not Office 2016.
I looked at the VBA differences between Office 2013 and 2016, but couldn't see anything about changes to the inspector or word editor for message objects.
Once it gets to .GetInspector.WordEditor it throws:
Run-time error '287':
Application-defined or object defined error
Here is the relevant part of the macro:
Sub SendEmail()
Dim actSheet As Worksheet
Set actSheet = ActiveSheet
'directories of attachment and email template
Dim dirEmail as String, dirAttach As String
' Directory of email template as word document
dirEmail = _
"Path_To_Word_Doc_Email_Body"
' Directories of attachments
dirAttach = _
"Path_To_Attachment"
' Email Subject line
Dim subjEmail As String
subjEmail = "Email Subject"
Dim wordApp As Word.Application
Dim docEmail As Word.Document
' Opens email template and copies it
Set wordApp = New Word.Application
Set docEmail = wordApp.Documents.Open(dirEmail, ReadOnly:=True)
docEmail.Content.Copy
Dim OutApp As Outlook.Application
Set OutApp = New Outlook.Application
Dim OutMail As MailItem
Dim outEdit As Word.Document
' The names/emails to send to
Dim docName As String, sendEmail As String, ccEmail As String, siteName As String
Dim corName As String
Dim row As Integer
For row = 2 To 20
sendName = actSheet.Cells(row, 1)
sendEmail = actSheet.Cells(row, 2)
ccEmail = actSheet.Cells(row, 3)
siteName = actSheet.Cells(row, 4)
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.SendUsingAccount = OutApp.Session.Accounts.Item(1)
.To = sendEmail
.CC = ccEmail
.Subject = subjEmail & " (Site: " & siteName & ")"
Set outEdit = .GetInspector.WordEditor
outEdit.Content.Paste
outEdit.Range(0).InsertBefore ("Dear " & sendName & "," & vbNewLine)
.Attachments.Add dirAttach
.Display
'.Send
End With
Debug.Print row
Set OutMail = Nothing
Set outEdit = Nothing
Next row
docEmail.Close False
wordApp.Quit
End Sub
Things I've tried based on suggestions:
Checked Outlook settings - default is HTML text
Moved .display over .GetInspector.WordEditor
Ensure Word is the default email editor. From the Inspector.WordEditor dox:
The WordEditor property is only valid if the IsWordMail method returns True and the EditorType property is olEditorWord . The returned WordDocument object provides access to most of the Word object model...
Further, ensure that Outlook is configured to send Rich Text or HTML emails, not plain text.
I am not entirely sure if I had the same issue as you, but the call to GetInspector started failing for me after upgrading Office 2016. So to be clear it worked with Office 2016 and then stopped working after the latest update.
The following workaround worked for me
dim item : set item = Addin.Outlook.CreateItemFromTemplate(Filename)
Outlook.Inspectors.Add(item) ' Outlook is the application object
it only appears to work if I add the item straight after creating it, setting properties on it and then adding it did not work.
Note: I have not tested with CreateItem instead of CreateItemFromTemplate. The second line was added and unnecessary prior to the Office update.
Problem:
For security purposes, the HTMLBody, HTMLEditor, Body and WordEditor properties all are subject to address-information security prompts because the body of a message often contains the sender's or other people's e-mail addresses. And, if Group Policy does not permit then these prompts do not come on-screen. In simple words, as a developer, you are bound to change your code, because neither registry changes can be made nor group policy can be modified.
Hence, if your code suddenly stopped working after migrating to Office 365 or for any other reasons, please refer to the solutions below. Comments have been added for easy understanding and implementation.
Solution 1:
If you have administrative rights then try the registry changes given at below link:
https://support.microsoft.com/en-au/help/926512/information-for-administrators-about-e-mail-security-settings-in-outlo
However, as developer, I recommend a code that's rather compatible with all versions of Excel instead of making system changes because system changes will be required on each end user's machine as well.
Solution 2: VBA Code
Code Compatible: Excel 2003, Excel 2007, Excel 2010, Excel 2013, Excel 2016, Office 365
Option Explicit
Sub Create_Email(ByVal strTo As String, ByVal strSubject As String)
Dim rngToPicture As Range
Dim outlookApp As Object
Dim Outmail As Object
Dim strTempFilePath As String
Dim strTempFileName As String
'Name it anything, doesn't matter
strTempFileName = "RangeAsPNG"
'rngToPicture is defined as NAMED RANGE in the workbook, do modify this name before use
Set rngToPicture = Range("rngToPicture")
Set outlookApp = CreateObject("Outlook.Application")
Set Outmail = outlookApp.CreateItem(olMailItem)
'Create an email
With Outmail
.To = strTo
.Subject = strSubject
'Create the range as a PNG file and store it in temp folder
Call createPNG(rngToPicture, strTempFileName)
'Embed the image in Outlook
strTempFilePath = Environ$("temp") & "\" & strTempFileName & ".png"
.Attachments.Add strTempFilePath, olByValue, 0
'Change the HTML below to add Header (Dear John) or signature (Kind Regards) using newline tag (<br />)
.HTMLBody = "<img src='cid:DashboardFile.png' style='border:0'>"
.Display
End With
Set Outmail = Nothing
Set outlookApp = Nothing
Set rngToPicture = Nothing
End Sub
Sub createPNG(ByRef rngToPicture As Range, nameFile As String)
Dim wksName As String
wksName = rngToPicture.Parent.Name
'Delete the existing PNG file of same name, if exists
On Error Resume Next
Kill Environ$("temp") & "\" & nameFile & ".png"
On Error GoTo 0
'Copy the range as picture
rngToPicture.CopyPicture
'Paste the picture in Chart area of same dimensions
With ThisWorkbook.Worksheets(wksName).ChartObjects.Add(rngToPicture.Left, rngToPicture.Top, rngToPicture.Width, rngToPicture.Height)
.Activate
.Chart.Paste
'Export the chart as PNG File to Temp folder
.Chart.Export Environ$("temp") & "\" & nameFile & ".png", "PNG"
End With
Worksheets(wksName).ChartObjects(Worksheets(wksName).ChartObjects.Count).Delete
End Sub
Try moving the editor to the first action...
...
With OutMail
Set outEdit = .GetInspector.WordEditor
outEdit.Content.Paste
.SendUsingAccount = OutApp.Session.Accounts.Item(1)
.To = sendEmail
.CC = ccEmail
.Subject = subjEmail & " (Site: " & siteName & ")"
...

Automate trigger from email that has been replied

I am new in VBA. I would like to ask on how to trigger email which has been reply.
Scenario : I have this coding as below which send the email to recipient (Column B) if there is "yes" in column C.
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*#?*.?*" And _
LCase(Cells(cell.Row, "C").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Reminder"
.Body = "Dear " & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"Please contact us to discuss bringing " & _
"your account up to date"
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Display
End With
Question : How can I trigger if the recipient has replied to my email that I sent earlier? I would like to automate the trigger to my excel file on column E as remark recipient has replied to my email. Ex, "replied / no reply".
Really appreciate for any help since I am new in VBA.
Thank you.
Assuming your using Microsoft Outlook and an Exchange Server.
There are 3 Extended MAPI properties that deal with the message state for replied to/forwarded:
PR_ICON_INDEX (0x10800003)
PR_LAST_VERB_EXECUTED (0x10810003)
PR_LAST_VERB_EXECUTION_TIME (0x10820040)
This MSDN article https://msdn.microsoft.com/en-us/library/bb176395(office.12).aspx provides code that shows how to use these MAPI Properties:
Sub DemoPropertyAccessorGetProperty()
Dim PropName, Header As String
Dim oMail As Object
Dim oPA As Outlook.PropertyAccessor
'Get first item in the inbox
Set oMail = _
Application.Session.GetDefaultFolder(olFolderInbox).Items(1)
'PR_TRANSPORT_MESSAGE_HEADERS
PropName = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
'Obtain an instance of PropertyAccessor class
Set oPA = oMail.PropertyAccessor
'Call GetProperty
Header = oPA.GetProperty(PropName)
Debug.Print (Header)
End Sub
You will want to replace the 'PR_TRANSPORT_MESSAGE_HEADERS ie 0x007D001E in the above code and I'm guessing you'll want to go through more than just the first mail item...

Resources