I'm trying to, in Excel 2016, send an email in Outlook 2016 with a table in the email body.
I've researched Stack Overflow as well as other websites. I find the HTML part confusing.
Below is the code I've written, to send an email. The code works, but I need to replace the .HTMLBody = "Hello World" with a table.
Sub Send_mail()
Dim outlookApp As Outlook.Application
Dim outlookMail As Outlook.MailItem
Set outlookApp = New Outlook.Application
Set outlookMail = outlookApp.CreateItem(olMailItem)
With outlookMail
.To = "recipient#mail.com"
.CC = ""
.BCC = ""
.Subject = "TEST123"
.BodyFormat = olFormatHTML
.HTMLBody = "Hello World"
.Send
End With
Set outlookMail = Nothing
Set outlookApp = Nothing
End Sub
The table to insert in the body of the email consists of columns A, B, C and D.
The data always begin on row 2 but the row containing the last data needs to be dynamic.
The table will always be fairly small - max 20 rows ish.
I imagine the following might do the trick?
Locating the last populated row then looping to go through each row between 2 and the last populated row and convert it into HTML format and storing that as a string. Then concatenate those strings into one final string to put in the body of the email.
I've looked at Ron de Bruin's guides, but I would like to achieve this without having to create a temporary file or use non-Microsoft tools. The macro will have several users from a professional company, and needs to be bulletproof. I fear that saving temporary files and deleting them could result in horrible mistakes if the company's shared-folder structure is changed.
To Copy From Column A2: to Column D/or Column 4 last used range, Example would be
With ThisWorkbook.Worksheets("Sheet1")
Dim rng As Range
Set rng = .Range("$A$2:" & .Cells( _
.Rows.Count, 4) _
.End(xlUp).Address)
Debug.Print rng.Address ' Print on immediate Window
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
End With
See Copy Excel range as Picture to Outlook
Related
I made a 2 cell contain Date (B2:B10) and Time (C2:C10).
I declare the cell so that it will send email based on date & time in cell but it show automation error
Sub Send_Deferred_Mail_From_Excel()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim cell As Range
Set cell = Range("B2:C2")
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
'Send Email Using Excel VBA Macro Code
With OutlookMail
.To = "gaelvin#gmail.com"
.CC = "nickjames#gmail.com"
.BCC = ""
.Subject = "Happy New Year"
.Body = "Greeting Gael, Wish You a Very Happy New Year"
'Send email on specific date & time
.DeferredDeliveryTime = Range("B2:C2")
.Display 'or just put .Send to directly send the mail instead of display
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub
DeferredDeliveryTime accepts a date as a value, so you need to combine the date and time that you have into a single value.
Due to the way dates work in VBA, you can simply add them together and it should work:
.DeferredDeliveryTime = Range("B2") + Range("C2")
I would also suggest to add some checks that those ranges contain valid time and dates if you have the chance.
I need an excel file to email an exported chart to a varying number of contacts on open. For every email, the chart needs to be refiltered. I figured out how to do this by creating a dynamic chart with a scrollbar and on each iteration of the loop I will at 13 to its position (p).
How do I get my VBA code to send an email with the exported chart to whatever is in column 2? It also is currently only sending one email, rather than however many are in the column. Any help would be awesome.
Private Sub Workbook_Open()
Dim b1 As Workbook, b2 As Workbook
Dim sh As Worksheet
Set b1 = ThisWorkbook
Dim olApp As Object
Dim olMail As Object
Dim i As Long
Dim p As Integer
Dim email As Range
Dim book As Range
Set olApp = CreateObject("Outlook.application")
Set olMail = olApp.createitem(i)
Set book = Range("A1:B9")
p = 1
'START LOOP
For Each email In book.Rows
Sheets("nothing").Range("B1").Select
ActiveCell.FormulaR1C1 = p
Worksheets(1).ChartObjects(1).Activate
ActiveChart.Export "testchartlocation.png"
With olMail
.To = "test#email.com"
.Subject = "Emailer Testing..."
.HTMLbody = "<html><p>Testing...</p><img src='testchartlocation.png'>"
.display
End With
p = p + 13
Application.Wait (Now + TimeValue("0:00:01"))
Next
'END LOOP
'ThisWorkbook.Close False
End Sub
If by
How do I get my VBA code to send an email with the exported chart to
whatever is in column 2?
You mean you have email addresses stored in column 2 that you need to access with each iteration to send the exported chart to, you could change this line
.To = "test#email.com"
To
.To = Cells(email.Row, 2) '<-Make sure to qualify this range with whatever worksheet you're pulling from
Concerning your issue with your email only being generated once, you need to move
Set olMail = olApp.createitem(i) '<- you can change `i` to `0`
Into the beginning of your For-Next loop and set it = Nothing at the end like
For Each email In book.Rows
Set olMail = olApp.createitem(0)
'Do Stuff
Set olMail = Nothing
Next email
That way a new email is generated every iteration.
EDIT:
You can probably get rid of this line
Sheets("nothing").Range("B1").Select
And replace
ActiveCell.FormulaR1C1 = p
With
Sheets("nothing").Range("B1").FormulaR1C1 = p
Since you're working with multiple sheets and .Activate functions, I would recommend qualifying all of your ranges.
I am trying to pull email addresses from a column in an Excel Data table and have those email addresses be the receiver of email based on a template.
Code I made below.
Sub Mail_experiment()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.Mailtem
Set OutApp = CreateObject("Outlook.Application")
Set = OutMail
OutApp.CreatItemFromTemplate("C:\Users\Name\Documents\Project\PO Accrual Support Email Template.oft")
On Error Resume Next
With OutMail
.To = "J.Doe#gmail.com"
.CC = ""
.BC = ""
.Subject = ""
.Save
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
All separate emails will be sent later, hence .Save. Also, I am attempting to pull what would be the subject line of the email from another column in the data table.
How would I achieve both concepts with what I have so far?
You should create a function that returns a new MailItem based on your template. In this way, you will be able to test the new MailItem separately without having to run the complete code.
I like to enumerate my excel columns. This makes it both easier to refer to the correct column and to update the code if the column order is changed.
Option Explicit
'Enumeration is by defination the action of establishing the number of something
'I Enumerate my Worksheet Columns to give them a meaningful name that is easy to recognize
Public Enum EmailColumns
ecEmailAdresses = 1
ecSubject = 3
End Enum
Public Sub SaveEmails()
Dim r As Long
'The With Statement allows you to "perform a series of statements on a specified object without specifying the name of the object multiple times"
'.Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row actually refers to ThisWorkbook.Worksheets("Support Emails").Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row
With ThisWorkbook.Worksheets("Support Emails")
'.Cells(): references a cell or range of cells on Worksheets("Support Emails")
'.Cells(.Rows.Count, ecEmailAdresses): Refrences the last cell in column 1 of the worksheet
'.End(xlUp): Changes the refererence from the last cell to the first used cell above the last cell in column 3
'.Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row: returns the Row number of the last used cell in column 3
For r = 2 To .Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row
getPOAccrualTemplate(MailTo:=.Cells(r, ecEmailAdresses), Subject:=.Cells(r, ecEmailAdresses)).Save
Next
End With
End Sub
Public Function getPOAccrualTemplate(MailTo As String, Optional CC As String, Optional BCC As String, Optional Subject As String) As Object
Const TEMPLATE_PATH As String = "C:\Users\Name\Documents\Project\PO Accrual Support Email Template.oft"
Dim OutApp As Object, OutMail As Object
' CreateObject("Outlook.Application"): Creates an instance of an Outlook Application.
' Outlook.Application.CreateItemFromTemplate returns a new MailItem Based on a saved email template
Set OutMail = CreateObject("Outlook.Application").CreateItemFromTemplate(TEMPLATE_PATH)
With OutMail
.To = MailTo
.CC = CC
.BCC = BCC
.Subject = Subject
End With
'Returns the new MailItem to the caller of the function
Set getPOAccrualTemplate = OutMail
End Function
Immediate Window Tests
'Test getPOAccrualTemplate
' Assign Values to Varaible
MailTo = "ti#stackoverflow.com"
CC = "efrenreyes#youdontwantnoneson.com"
BCC = "alexp#gmail.com"
Subject = "Who is going to the tournament tonight?"
'Test Variables using "," to insert Tabs between values
?MailTo, CC, BCC, Subject
?MailTo;"-";CC;"-";BCC;"-";Subject
'Pass variables into getPOAccrualTemplate and return a new MailItem based on the template
'variables created in the immediate window are Variant Type
'CStr is used to cast the values to Strings
set OutMail = getPOAccrualTemplate(CStr(MailTo), CStr(CC), CStr(BCC), CStr(Subject))
'Find out what type of object was returned
?TypeName(OutMail)
'Display the Mail Item
OutMail.Display
'Test Enumerate Columns
Columns(EmailColumns.ecEmailAdresses).Select
Columns(ecSubject).Select
MailTo = Cells(2, ecEmailAdresses)
CC = ""
BCC = ""
Subject = Cells(2, ecSubject)
'Test the function directly
getPOAccrualTemplate(CStr(MailTo), CStr(CC), CStr(BCC), CStr(Subject)).Display
'Test SaveEmails() Make sure and add a breakpoint
SaveEmails
?.Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row
Video Tutorials
These are two videos from my favorite VBA tutorial series that are relevant:
Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset)
Excel VBA Introduction Part 26 - Constants and Enumerations (Const, Enum)
You should just slightly refactor your code. The macro sending the email should take (at least) the email adress and the subject in parameter:
Sub Mail_experiment(ByVal address As String, ByVal subject As String)
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.Mailtem
Set OutApp = CreateObject("Outlook.Application")
Set = OutMail
OutApp.CreatItemFromTemplate("C:\Users\Name\Documents\Project\PO Accrual Support Email Template.oft")
On Error Resume Next
With OutMail
.To = address '<-- use the input here
.CC = ""
.BC = ""
.Subject = subject '<-- use the input here
.Save
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Hence, supposing you have the email addresses in the column A and the subjects in the column B (from 1 to 10, for example), you'd just need to call the macro in a loop:
For j = 1 To 10
Mail_experiment Range("A" & j), Range("B" & j)
Next j
The above will call the Mail_experiment macro 10 times, each time passing a new parameter (A1 - B1, then A2 - B2 etc.)
I'm upgrading an Excel macro. I want to generate an email copying in a table that changes range daily.
Strbody populates the email but the timetable isn't attaching.
Sub Ops_button()
'Working in Office 2000-2010
Dim Outapp As Object
Dim Outmail As Object
Dim Strbody As String
Dim Timetable As String
'Auto Email Attachment Variables
Set Outapp = CreateObject("Outlook.Application")
Set Outmail = Outapp.createitem(0)
Timetable = Sheets("sheet1").Range("C2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Strbody = "body text."
On Error Resume Next
With Outmail
'Send email
.To = ""
.bcc = ""
.Subject = "Report" & " " & Format$(Date, "dd-mm-yyyy")
.body = Strbody & Timetable
On Error Resume Next
.Display
End With
On Error GoTo 0
Set Outmail = Nothing
Set Outapp = Nothing
End Sub
You can't do this the way you're trying to do it... Let's see why not :)
You've declared Timetable as a String type variable. In this statement, you're assigning its value as the return from the .Select method (which will return a value of True if there is no error).
Timetable = Sheets("sheet1").Range("C2").Select
So, you're in no way appending the Table's Range object to the string, in this statement:
.body = Strbody & Timetable
Instead, you really need to either convert the table to HTML or copy and paste the range directly from Excel to Word.
Use Ron de Bruin's function to convert the table to an HTML PublishObject and insert that to the email, or
.Display the MailItem and then get a handle on the MailItem's .Inspector object (which is really just a Word document)
For the solution 1, adapt the answer already given, here:
Paste specific excel range in outlook
For the solution 2, you'll need to use the method outlined here to get the Inspector (Word Document representing the Email item):
https://msdn.microsoft.com/en-us/library/office/ff868098.aspx
Then, Dim TimeTable as Range, and change code to:
Set Timetable = Sheets("sheet1").Range("C2").End(xlToRight).End(xlDown)
Then, copy the table:
Timetable.Copy
And then following the MSDN link above once you have a handle on the Inspector, get the destination range in Outlook (Word) and you can use the PasteAndFormat method of a Word.Range object:
Dim wdRange as Object 'Word.Range
OutMail.Display
Set wdRange = OutMail.getInspector().WordEditor.Range
wdRange.Text = strBody
wdRange.Expand (1)
wdRange.Characters.Last.PasteAndFormat 16 'wdFormatOriginalFormatting
Option 2 would be my preferred method. I'm on a computer that doesn't have outlook, so I'm winging this a little bit from memory and I can't test right now, but if you have any issues with it just leave a comment and I'll try to help out some more in the morning.
I have a piece of basic excel to email code however, i want to know how i can make it so that it can add several different cells to the body of the email. This needs to include a few ranges as well. These ranges should only display values from cells that actually contain a value, not blank ones.
E.g.
So i'd like for example
B12 data
(line break x 2)
E15:E20 Data
(LineBreak x2)
F19:F20 Data
My code as it stands is:
Sub Send_to_Email()
On Error GoTo PROC_EXIT
Dim OL As New Outlook.Application
Dim olMail As Outlook.MailItem
Set olMail = OL.CreateItem(olMailItem)
Dim SrcSheet As Excel.Worksheet
Set SrcSheet = Sheets("Clean (2)")
With olMail
.To = SrcSheet.Range("A19").Text
.Subject = SrcSheet.Range("F19").Text
.Body = SrcSheet.Range("B19").Text
.Display vbModal
'.Send
End With
PROC_EXIT:
On Error GoTo 0
Set OL = Nothing
End Sub
I'd suggest looking into using HTMLbody instead of body. Then you can freely add your <br/> or any other formatting you want.
As an added bonus, you don't need to worry about your whitespace as you build the body string. Though obviously, you'd still want it legible as you work out your problem.
As for the ranges, check all the relevant cells and include something like:
If Range.value <> "" then
'Do Stuff
end if