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
Related
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 have a user who sends eMails to a large "To" list, Sometimes over 20 addresses. With this large a "To" list, the received mail sometimes ends up on the recipient's SPAM folder. Obviously, we'd like to avoid this.
My idea is to have the user create an original eMail and then run a Macro. The Macro would loop through all the eMail addresses in an Excel worksheet and then copy the original message and send it to each recipient individually.
I'm unsure as to how to copy a MailItem from the original to a new MailItem. The Excel looping works fine.
Here's my abbreviated macro:
Option Explicit
Sub Send_emails()
'.
'.
Set objDoc = objInspector.WordEditor
Set objWrdApp = objDoc.Application
Set objSelection = objWrdApp.Selection
'Loop through the Rows in the worksheet. Start at row 2 to ignore header
For lngCurrSheetRow = 2 To lngLastSheetRow
strEmailAddress = objWorksheet.Cells(lngCurrSheetRow, 1).Value
'Set objNewMail so that the new message is created and can be referenced.
Set objNewMail = Application.CreateItem(0)
With objNewMail
.Body = objSelection
.To = strEmailAddress
End With
Next lngCurrSheetRow
'.
'.
End Sub
To copy mailitem.body Example would be
Option Explicit
Sub Send_emails()
Dim olMsg As Outlook.MailItem
Set olMsg = ActiveExplorer.Selection.Item(1)
Dim objNewMail As Outlook.MailItem
Set objNewMail = Application.CreateItem(0)
With objNewMail
.Body = olMsg.Body
.Display
End With
End Sub
For HTML Body simply do HTMLBody = olMsg.HTMLBody
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
I have some VBA code that I'm using to send texts from Outlook to team members of my project at work. For some background: for non-AT&T subscribers, we have no issue sending text messages from Outlook by plugging in peoples' numbers en masse into the To: field of Outlook emails. However, all AT&T subscribers will receive the text as a group message, which we want to avoid. The non-AT&T subscribers correctly receive individual texts when we do a group send.
We've written some VBA code to loop through a spreadsheet of AT&T numbers so that Outlook sends one email per AT&T number. This has been working fine for us, however, we were hoping to add some emojis into the texts that we're sending. I've done a lot of Googling and searching through stackoverflows questions, and I can't seem to find any code built for this purpose. I'm also a complete noob when it comes to VBA, and I've pieced this solution together thus far from getting help from a coworker and reading through threads on the internet. This bit about emojis has given me enough trouble that I thought I'd break down and submit this post.
For reference, here is my code:
Sub EmojiTest()
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim MobileNumber As String
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
Set xlApp = CreateObject("Excel.Application")
'Grab list from Excel
Set xlAtt = xlApp.Workbooks.Open("C:\Users\Username\Desktop\Spreadsheet with AT&T numbers.xlsx")
xlAtt.Activate
LastRow = xlAtt.ActiveSheet.Range("B" & xlAtt.ActiveSheet.Rows.Count).End(-4162).Row
For i = 1 To LastRow
xlAtt.Activate
MobileNumber = xlAtt.ActiveSheet.Range("B" & i).Value
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
objOutlookMsg.SentOnBehalfOfName = "TeamAccount#work.com"
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(MobileNumber)
objOutlookRecip.Type = olTo
' Set the Subject, Body, and Importance of the message.
.Subject = "Emoji Test"
.Body = "Text with emojis"
.Save
.Send
End With
Next i
Set objOutlook = Nothing
xlApp.Workbooks.Close
Set xlApp = Nothing
End Sub
This is code I never could have come up with myself due to my complete lack of experience with VBA, and limited experience coding in general. Any help is much appreciated.
Change:
.Body = "Text with emojis"
To:
.Body = "\ud83d\ude03"
Full list available here. Copy the box called Java escape string.
The \u escapes the unicode sequence, so typing "\u" and the UTF-16 sequence should let you insert any Emoji.
Some Emojis are actually 2 seperate char sequences, so you have to chain them together.
There is a solution at this link.
As per this, you paste smiley in an Excel cell and then read the cell value, it will be string with length 2, find the code of these 2 characters using AscW() and then chain them using Chrw, e.g. to have a smiley you can use ChrW(-10179) & ChrW(-8638).
I got it!
Sub EmojiTest()
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim MobileNumber As String
Dim strbody As String
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
Set xlApp = CreateObject("Excel.Application")
'Grab list from Excel
Set xlAtt = xlApp.Workbooks.Open("C:\Users\user\Desktop\Spreadsheet.xlsx")
xlAtt.Activate
LastRow = xlAtt.ActiveSheet.Range("B" & xlAtt.ActiveSheet.Rows.Count).End(-4162).Row
For i = 1 To LastRow
xlAtt.Activate
MobileNumber = xlAtt.ActiveSheet.Range("B" & i).Value
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
objOutlookMsg.SentOnBehalfOfName = "Team#work.com"
strbody = "<BODY style=font-size:11pt;font-family:Segoe UI Symbol>🎉Congrats!<p>Paragraph 2.<p>Paragraph 3.</BODY>"
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(MobileNumber)
objOutlookRecip.Type = olTo
' Set the Subject, Body, and Importance of the message.
.Subject = "Emoji Test"
.HTMLBody = strbody
.Save
.Send
End With
Next i
Set objOutlook = Nothing
xlApp.Workbooks.Close
Set xlApp = Nothing
End Sub
Basically, I had to convert my message into HTML. I did that using, "Dim strbody As String" at the top, and then using ".HTMLBody = strbody" in my With statement. Once I did that, it was trivial to use the HTML hex code to enter in my emoji. Here is a page with the HTML hex code that I used (🎉): http://www.fileformat.info/info/unicode/char/1f389/index.htm.
Learned a lot about using VBA doing this, so it was fun.
Thanks for your help Sam.
I'm running a report that gets distributed via email. In the email is a hyperlink to the report and a range of cells copied out of it as a snapshot of the report content. I'm trying to automate and found some VBA, but I'm not a programmer and can't modify it for my needs.
The VBA below gets me most of the way, but for 2 shortcomings:
1) I need the hyperlink to point to the specific file I'm referencing in the email, which changes daily (i.e. a unique workbook is created). The below uses a static hyperlink. I was trying to figure out a way to derive the hyperlink from a cell reference.
2) When copying the hyperlink and range of cells from excel into the email, I need the cells below the hyperlink. The below puts the range above the hyperlink.
I'd like to preserve the approach taken in the below VBA of referencing a worksheet to derive the email. It appears easy to deploy on other reports which get distributed.
Sub CreateMail()
Dim rngSubject As Range
Dim rngTo As Range
Dim rngCc As Range
Dim rngBody As Range
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With ActiveSheet
Set rngTo = .Range("B1")
Set rngCc = .Range("B3")
Set rngSubject = .Range("B2")
Set rngBody = .Range("H6:K22")
End With
rngBody.Copy
With objMail
.Body = "Please click on the link below..." & vbCrLf & "rngBody.Paste" & vbCrLf & _
"file:\\dbd03\nccode\Router_Proc\04Routing.txt"
End With
With objMail
.To = rngTo
.Cc = rngCc
.Subject = rngSubject
.Display
End With
SendKeys "^({v})", True
Set objOutlook = Nothing
Set objMail = Nothing
1) To make the file link dynamic, you can just include the reference of the cell, containing the file name, in the file path.
"<file:\\dbd03\nccode\Router_Proc\" & _
ActiveSheet.Range(<cell address here>) & ">"
Note: You might want to also check to make sure the path exists (like this) before putting it in the email
2) To paste the cells below the hyperlink, you can use another SendKeys combination to simulate the pressing of Ctrl + End, which will place the cursor at the end of the email. Doing this before using SendKeys to simulate the Ctrl + V should paste the range of cells after your body text. Your updated code should be the following:
With objMail
.To = rngTo
.Cc = rngCc
.Subject = rngSubject
.Display
End With
SendKeys "^({END})", True '<--- Add this line HERE
SendKeys "^({v})", True
Another Note: Also, i don't think you need "rngBody.Paste" in your Body string, as this just pastes that exact text in your email body