How to attach active Excel workbook to an email - excel

I have been trying all morning to get this VBA script to attach my active excel document to an auto-generated outlook message. Everything works fine if I declare the file path as a string and attach it. Except that I would like to attach the full file path of the current excel document instead of using a static string value.
Here is my code:
Private Sub CommandButton1_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim sAttach As String
Dim sTo As String
Dim sCC As String
'For To field
Set emailRng = Worksheets("Pre-Clearance Email").Range("E11:J14")
For Each cl In emailRng
sTo = sTo & ";" & cl.Value
Next
sTo = Mid(sTo, 2)
'For CC field
Set emailRngCC = Worksheets("Pre-Clearance Email").Range("E16:J19")
For Each cl In emailRngCC
sCC = sCC & ";" & cl.Value
Next
sCC = Mid(sCC, 2)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'variable declarations for email body and attachment
strbody = "<BODY style=font-size:11pt;font-family:Calibri>Good Morning;<p>Please see the attached aliases for validation. Please let me know if you have any questions.<p>Thank you.</BODY>"
sAttach = "K:\CRM Support\Data\Systematic Trade Recon (1).xlsm"
'the below code adds a users default signature to the email
With OutMail
.Display
End With
signature = OutMail.HTMLBody
With OutMail
.to = sTo
.CC = sCC
.Subject = "STR Pre-Clearance"
.HTMLBody = strbody & signature
.Attachments.Add (ActiveDocument.FullName)
'.Attachments.Add sAttach
.Display 'Instead of .Display, you can use .Send to send the email _
or .Save to save a copy in the drafts folder
End With
The compiler gives me an error at this line:
.Attachments.Add (ActiveDocument.FullName)
I have done some research, and tried to fix the problem myself, but I just can't figure out how to make this script attach the active file to this outlook message. As you can see by my code, my backup option is to just use a string variable and a static address to attach the file, but I would rather make this script more versatile than that.
Here is one of the sites which I found that gave me this idea to begin with: Here

Well, after some more effort I was able to get the workbook to attach flawlessly. Here was the revision I made to the OutMail Object in my orginial code:
With OutMail
.to = sTo
.CC = sCC
.Subject = "STR Pre-Clearance"
.HTMLBody = strbody & signature
.Attachments.Add (ActiveDocument.FullName) 'this is the correction I made
.Display
I figured I would answer my own question so it doesn't linger without a technical answer. Maybe it will help someone in the future.

The fix should actually be:
With OutMail
.To = sTo
.CC = CC
.Subject = "STR Pre-Clearance"
.HTMLBody = strbody & signature
.Attachments.Add (ActiveWorkbook.FullName) 'should be workbook not document
.Display 'or .Send

Related

How to add JPG file at specific location in email body created from a template?

I'm trying to distribute emails using an Outlook oft template.
On the oft template, at a specific location, I want to attach a jpg file which I have created from Excel range.
Dim OutApp As Object
Dim OutMail As Object
Dim str_jpeg_file as String
str_jpeg_file = "B:\temp\test.jpg"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItemFromTemplate(ThisWorkbook.Path & "\Test.oft")
With OutMail
.To = "test#abcd.com"
.CC = ""
.BCC = ""
.Subject = "Test mail"
.SentOnBehalfOfName = "zyz#abcd"
.Attachments.Add str_jpeg_file, 1, 0
.HTMLBody = Replace(.HTMLBody, "##IMAGE_PLACEHOLDER##", "<img src=""cid:test.jpg""height=520 width=750>")
'.Send
.display
End With
Edit:
jpg file path updated i.e. str_jpeg_file
To give you a full working example:
Option Explicit
Sub test()
Dim OutApp As Object
Dim OutMail As Object
Dim str_jpeg_file As String
str_jpeg_file = "C:\Temp\test.png"
Set OutApp = CreateObject("Outlook.Application")
'Set OutMail = OutApp.CreateItemFromTemplate(ThisWorkbook.Path & "\Test.oft")
'instead of a template I create a new mail
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "test#abcd.com"
.CC = ""
.BCC = ""
.Subject = "Test mail"
.SentOnBehalfOfName = "zyz#abcd"
.Attachments.Add str_jpeg_file, 1, 0
'first we write some placeholder text so we can replace it
.HTMLBody = "lalala ##IMAGE_PLACEHOLDER## lala"
'replace
.HTMLBody = Replace(.HTMLBody, "##IMAGE_PLACEHOLDER##", "<img src=""cid:test.png""height=256 width=256>")
'.Send
.display
End With
End Sub
Note that I used a new email (no template) because it is easier to show here.
And it works perfectly:
So if it doesn't work for you either your image file is no valid image or you did something else wrong like typos etc. or your template is somehow the issue. Check again with the code above.

How to embed an image into an Outlook email using VBA

Very closely related to Embed picture in outlook mail body excel vba
I'm trying to embed an image into an Outlook email.
I'm using the following code snippet, half of which has been stolen from the post above:
Sub PictureEmail()
Dim outApp As New Outlook.Application
Dim OutMail As Object
Dim Attchmnt As String
Dim Signature As String
Dim WB As Workbook
Set WB = ThisWorkbook
Attchmnt = "C:\Users\Blah\Painted_Lady_Migration.jpg"
Set OutMail = outApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = WB.Names("to").RefersToRange.Value2
.CC = WB.Names("cc").RefersToRange.Value2
.BCC = WB.Names("bcc").RefersToRange.Value2
.Subject = WB.Names("Subject").RefersToRange.Value2
.HTMLBody = "<img src=""cid:Painted_Lady_Migration.jpg""height=520 width=750>"
.display
End With
If Attchmnt = "" Then
Else
OutMail.Attachments.Add Attchmnt
End If
On Error GoTo 0
End Sub
However, when looking at the generated email, I have the error "The linked image cannot be displayed. The file may have been moved, renamed, or deleted".
I've tried a few different ways to attach the file, including:
.HTMLBody = "<img src=" & Chr(34) & "cid:Painted_Lady_Migration.jpg" & Chr(34) & "height=520 width=750>"
I just can't get it to work >_<
I saw somewhere that spaces in the name/filepath can throw it, so I replaced the spaces in the name with underscores
What dumb thing am I forgetting/missing?
The cid is created when you attach it, so you need to do that before you display/send it.
Try it like this
Set OutMail = outApp.CreateItem(0)
With OutMail
.To = WB.Names("to").RefersToRange.Value2
.CC = WB.Names("cc").RefersToRange.Value2
.BCC = WB.Names("bcc").RefersToRange.Value2
.Subject = WB.Names("Subject").RefersToRange.Value2
If Attchmnt <> "" Then
.Attachments.Add Attchmnt ' (additional arguments are optional)
.HTMLBody = "<img src=""cid:Painted_Lady_Migration.jpg"" height=520 width=750>"
Else
.HTMLBody = "[no attachment included]"
End If
.Display
End With

Adding TAB to the beginning of a text string in Excel VBA

I've assembled the following code that creates the following text in the body of an Outlook email when run.
Sub InitialEvaluationWalkThru()
Dim OutApp As Object
Dim OutMail As Object
Dim strto As String, strcc As String, strbcc As String
Dim strsub As String, strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strto = "first.last#me.com"
strcc = ""
strbcc = ""
strsub = [$C$8] & " Update"
strbody = "<H5>Hello Everyone,</H5>" & _
"<H5>The Template conference rooms " & Cells(FormulaCell.Row, "C").Value & " phase is now complete!</H5>" & _
"<H4>The overall room deployment is " & [$E$8] & "% Complete!</H4>" & _
"<H5>Let me know if you have any questions,</H5>"
With OutMail
.Display
.To = strto
.CC = strcc
.BCC = strbcc
.Subject = strsub
' .Body = strbody
.HTMLBody = strbody & .HTMLBody
'You can add a file to the mail like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Outlook Email
Hello Everyone,
The Template conference rooms Initial Evaluation Walk-Thru phase is
now complete!
The overall room deployment is 0.125% Complete!
Let me know if you have any questions,
Question
I am trying to indent the third line and have tried many different combos with no luck. I've also tried to have the cell value percentage from my sheet as 13% not 0.125%, also with no luck.
Any help would be greatly appreciated.
Thank You
For the value, you should be able to simply multiply it by 100:
"<H4>The overall room deployment is " & CInt(100 * [$E$8]) & "% Complete!</H4>" &
CInt will round the value up or down. In your case it should round up 12.5 to 13.
As far as the tab, I would try what #JNevill suggests and use or   (see Special Characters) but put it in between <pre></pre> tags. See the many approaches discussed in this question: How to get a tab character?.

How to send an Excel sheet to Outlook mailbox?

I have an Excel document to log work done during the day to be passed to the nightshift so they are kept up-to-date with the days activites and vice versa.
The plan is to fill out the document and click a 'Send' button that will send the newly created Excel sheet to a shared Outlook folder.
My attempts have been scrapes off the web copied & tried, but to no avail.
Maybe it may help :)
Sub outMail()
Dim outApp As Object
Dim oMail As Object
Dim signature As String
Dim obszar As String
Set outApp = CreateObject("Outlook.Application")
Set oMail = outApp.CreateItem(0)
With oMail
.Display
End With
signature = oMail.Body
With oMail
.To = "email#email.com"
.CC = "email2#email.com"
.BCC = ""
.Subject = "Log work done during the day"
.BodyFormat = 2
.Body = "Hello" & Chr(13) & Chr(10) & "The newly created Excel sheet with log work done during the day " & Chr(13) & Chr(10) & signature
'here You put directory to your file, for now its directory to file where macro is
.Attachments.Add ActiveWorkbook.FullName
'now its set to display only, if You want to send automatically put .send as below
.Display
'.Send
End With
End Sub
If you use HTML for the email body, you will also be able to format the mail body. Just change the file path to attach the mail. If you want to include a new line in the mail body use < br > (without space).
Sub StackOverflow()
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
.To = "Johnston#Stackoverflow.com"
.Subject = "Excel Document"
.Display
.HTMLBody = "<p style='font-family:arial;font-size:13'>" & _
"Hi" & "<br>" & "<br>" & _
"Here is the Excel document." & _
.HTMLBody
.Attachments.Add ("C:\Desktop\" & "ExcelDocument.xlsx")
.Display
End With
End Sub

How to send email to multiple recipients with addresses stored in Excel?

I am trying to set up several buttons on an Excel form to email different groups of people.
I made several ranges of cells on a separate worksheet to list the email addresses.
For example, I want "Button A" to open Outlook and put the list of email addresses from "Worksheet B: Cells D3-D6". Then all that has to be done is hit "Send" in Outlook.
Sub Mail_workbook_Outlook_1()
'Working in 2000-2010
'This example send the last saved version of the Activeworkbook
Dim OutApp As Object
Dim OutMail As Object
EmailTo = Worksheets("Selections").Range("D3:D6")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = EmailTo
.CC = "person1#email.com;person2#email.com"
.BCC = ""
.Subject = "RMA #" & Worksheets("RMA").Range("E1")
.Body = "Attached to this email is RMA #" & Worksheets("RMA").Range("E1") & ". Please follow the instructions for your department included in this form."
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display
End With
On Error Goto 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
You have to loop through every cell in the range "D3:D6" and construct your To string. Simply assigning it to a variant will not solve the purpose. EmailTo becomes an array if you assign the range directly to it. You can do this as well but then you will have to loop through the array to create your To string
CODE
Option Explicit
Sub Mail_workbook_Outlook_1()
'Working in 2000-2010
'This example send the last saved version of the Activeworkbook
Dim OutApp As Object
Dim OutMail As Object
Dim emailRng As Range, cl As Range
Dim sTo As String
Set emailRng = Worksheets("Selections").Range("D3:D6")
For Each cl In emailRng
sTo = sTo & ";" & cl.Value
Next
sTo = Mid(sTo, 2)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = sTo
.CC = "person1#email.com;person2#email.com"
.BCC = ""
.Subject = "RMA #" & Worksheets("RMA").Range("E1")
.Body = "Attached to this email is RMA #" & _
Worksheets("RMA").Range("E1") & _
". Please follow the instructions for your department included in this form."
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
ToAddress = "test#test.com"
ToAddress1 = "test1#test.com"
ToAddress2 = "test#test.com"
MessageSubject = "It works!."
Set ol = CreateObject("Outlook.Application")
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.RecipIents.Add(ToAddress)
newMail.RecipIents.Add(ToAddress1)
newMail.RecipIents.Add(ToAddress2)
newMail.Send
Both answers are correct.
If you user .TO -method then the semicolumn is OK - but not for the addrecipients-method. There you need to split, e.g. :
Dim Splitter() As String
Splitter = Split(AddrMail, ";")
For Each Dest In Splitter
.Recipients.Add (Trim(Dest))
Next

Resources