Using VBA to attach a file in an outlook email - vba

I've created a subroutine that grabs all the relevant details and attachments to send out automated emails for me. Here is the code I have:
Sub Mail_workbook_Outlook_1()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim To1 As String, CC1 As String, BCC1 As String, Title1 As String, Body1 As String, Att1 As String
' Create "Other Distribution - In Email" Emails
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
To1 = Cells(8, 2).Value
CC1 = Cells(8, 3).Value
BCC1 = Cells(8, 4).Value
Title1 = Cells(8, 5).Value
Body1 = Cells(8, 6).Value
Att1 = Cells(8, 7).Value
On Error Resume Next
With OutMail
' BodyFormat command makes the email a rich format message allowing us to place attachments within the body of the email instead of in the attachment header
.BodyFormat = olFormatRichText
.To = To1
.CC = CC1
.BCC = BCC1
.Subject = Title1
.Body = Body1
.Attachments.Add Att1, , 10
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
This works fine and inserts my attachment at the end of my email body. The issue is this specific line:
.Attachments.Add Att1, , 10
In this code the "10" is supposed to represent the position of the attachment. I.E. this is supposed to mean that after the first 9 characters in my "Body1" variable, instead of the 10th character the attachment will be placed here. See here: https://msdn.microsoft.com/en-us/library/office/ff869553.aspx
However, for some reason no matter what number I put in the position option it always just puts my attachment at the very end of the email. I need the attachment to be in the middle of several paragraphs so this is causing an issue. Any idea what is causing this?
I should mention I have selected the Microsoft Outlook Object Library from Tools>References.
Any help is greatly appreciated!

So I found out that this is a bug in Outlook 2008/2010 for which there does not seem to be a fix :(
http://argurosblog.blogspot.com/2011/11/how-to-create-task-or-appointment-using.html

Change the content of the body with:
Body1 = "This is the body of the mail, line 1" & vbcrlf
Body1 = Body1 & "This is the second line of text, line 2" & vbcrlf
Body1 = Body1 & "This is the last line of text, line 3."
and run your code.
As you can see the attachment is not placed after the 10.th character, but after the first vbcrlf found after the 10.th character.
If you try with .Attachments.Add Att1, , 50 (in the middle of the second line), it will be placed between line 2 and line 3.
If you delete all the vbcrlfs characters in your body, it will placed at the end of the body, and that is probably what happens to you.
Parse the content of your body and insert vbcrlf ('hard returns') characters where needed.
Hope this helps.

Related

Paste range from word in mail body including the format

I'm working on a mail merge macro and I'm trying to copy the text from my word document including the format in the mail body unfortunately it doesn't accept the range.paste function there.
Looking forward to any advice.
Set oWord = CreateObject("Word.Application")
oWord.Documents.Open FileName:="*\Flightticket.docx", ReadOnly:=True
Set oDoc = oWord.ActiveDocument
Set oRange = ActiveDocument.Range(Start:=0)
oWord.Visible = False
oRange.Copy
*
*
*
With oMail
.To = oContact.Email1Address
.Subject = Left(oDoc.Name, Len(oDoc.Name) - 5) & " " & mText
.GetInspector.Activate 'Signatur
olOldBody = .HTMLBody
'The content of the document is used as the body for the email
.HTMLBody = oRange.Paste & olOldBody 'Here is the error
End With
I now worked around the problem with adding html code to my word document and included the whole content without copy-paste. This worked out pretty good.
.HTMLBody = oDoc.Content & olOldBody
.HTMLBody = oRange.FormattedText & olOldBody

My attachments lose their original name and are show as ProjectStatus.xlsx

In windows 7 and Office 2007 I have been using a code which opens a new email in Outlook, attach a file and send it. The code it's not mine, I found it somewhere in the internet. The problem is that now I use Windows 10 and Office 2016, and using the same code produce different results as:
The original name of the file, let's say for example "Products.xlsx", is changed to "ProjectStatus.xlsx" (any file name is always changed to "ProjectStatus.xlsx")
If I open the file then Excel opens it and shows the original name of the file ("Products.xlsx")
If I send it, sometimes the recipients see the attached file as "ProjectStatus.xlsx" and sometimes see it as "Products.xlsx". But what always happens is that if they open the file, in excel is seen as "Products.xlsx"
I need the file name always be shown with the original name. How can I do this?
This is the code I use it and is executed from both access 2016 and excel 2016.
Sub MandaMailA(destinatarios As String, copia As String, subject As String, strbody As String, attachment1 As String, Optional attachment2 As String = "", Optional CO As String = "")
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & _
"\Microsoft\Firmas\VBA.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With OutMail
.To = destinatarios
.CC = copia
.BCC = CO
.subject = subject
.HTMLBody = strbody & "<br>" & Signature
.Display 'or use .Display
.Attachments.Add attachment1, olByValue, 1, "ProjectStatus"
.Attachments.Add attachment2, olByValue, 1, "ProjectStatus"
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I notice that this code includes the word "ProjectStatus" but honestly I have not a deep knowledge of VBA.
Thanks in advance!!
A simple read of the Attachments.Add documentation is all you need, specifically the section on the optional DisplayName parameter:
This parameter applies only if the mail item is in Rich Text format
and Type is set to olByValue : the name is displayed in an Inspector
object for the attachment or when viewing the properties of the
attachment. If the mail item is in Plain Text or HTML format, then the
attachment is displayed using the file name in the Source parameter.
So if you always want to always use the original file name, simply delete the instances of , "ProjectStatus".

Reordering of text and attachment in Outlook Email

I am creating an email from a macro (Excel file Macro) and am trying to make the attachment be sandwiched by text. Using the following code the attachment is added after the signature, I would like for it to have body, file, signature
Set olMailItem = olApp.CreateItemFromTemplate(EmailFilePath)
With olMailItem
'search and replace subject for "KW ##" to the kw from "Key Metrics" tab
.Subject = Replace(.Subject, "KW ##", KW)
.Attachments.Add ("H:\QA\QA Mgmt\Presentations\" & reports(r).filename)
.Body = .Body & GetSignature(emailTemplatePath & "EmailSignature.txt")
.Display
End With
EmailFilePath is a path to an msg file with an existing body and reciepients. Is there a way I can force the signature to be added after the attached file?
Thanks in advance
The attachments can be placed inside of the body only when the "bodyformat" of the email is set to "Rich Text"
You can do this by implementing the following line of code into your function:
.BodyFormat = olFormatRichText ' 3 also works
Implementation
Set olMailItem = olApp.CreateItemFromTemplate(EmailFilePath)
With olMailItem
' **** Add this line vvvv ****
.BodyFormat = olFormatRichText ' 3 also works
'search and replace subject for "KW ##" to the kw from "Key Metrics" tab
.Subject = Replace(.Subject, "KW ##", KW)
.Attachments.Add ("H:\QA\QA Mgmt\Presentations\" & reports(r).filename)
.Body = .Body & GetSignature(emailTemplatePath & "EmailSignature.txt")
.Display
End With
Also, the 3rd parameter of the ".Attachments.Add" is "Position" and it is 0 by default but this number represents which character within the body that the attachment will be located. If your number is greater than the total amount of characters it will automatically be placed at the end. If your number is 1 it will be placed at the beginning.
This should work fine, just change the number of the position parameter
.Attachments.Add Source:="H:\QA\QA Mgmt\Presentations\" & reports(r).filename, Position:=100
More about Outlook Attachments: http://msdn.microsoft.com/en-us/library/office/ff869553(v=office.15).aspx

Excel VBA Sending emails with multiple attachements

So we are holding this big event and I have an excel sheet with everyones name, email address as well as their itinerary files (there are 2 of them) Cells(x, 3) and Cells(x, 4). What I am trying to do is go down the column and send everyone a 'personalized' email with all of their information.
In the code, the for loop only goes to 3 because I am just testing it out by sending the emails to myself and don't want to end up getting 1000 emails :P
I keep getting a Run-Time Error 440 (Automation Error) at the lines where I attempt to add the attachments... not sure what's going on or how to remedy it any help is appreciated
Code
Sub CreateHTMLMail()
'Creates a new e-mail item and modifies its properties.
Dim olApp As Object
Dim objMail As Object
Dim body, head, filePath, subject As String
Dim x As Long
Set olApp = CreateObject("Outlook.Application")
'Create e-mail item
Set objMail = olApp.CreateItem(0)
filePath = "\\fileserver\homeshares\Tsee\My Documents\Metropolitan Sales\MNF"
subject = "Important Travel Information for MNF Event this weekend"
x = 1
For x = 1 To 3
head = "<HTML><BODY><P>Hi " & Cells(x, 1).Value & ",</P>"
body = body & "<BR /><P>We are looking forward to having you at our <STRONG>Metropolitan Night Football Event</STRONG> this upcoming Sunday, <STRONG>11/17</STRONG>! Note, that the Giants game time has changed from 8:30 PM to 4:25 PM.</P>"
body = body & "<BR /><P>Please find attached your travel information packet that contains important addresses and confirmation numbers. Please read through it and let me know if you have any questions.</P>"
body = body & "<BR /><P>If you need to reach me this weekend, please call my cell phone <STRONG>(631) 793-9047</STRONG> or email me.</P>"
body = body & "<BR /><P>Thanks,<BR />Liz</P></BODY></HTML>"
With objMail
.subject = subject
.To = Cells(x, 2).Value
.Attachments.Add = filePath & "/" & Cells(x, 3).Value
.Attachments.Add = filePath & "/" & Cells(x, 4).Value
.BodyFormat = olFormatHTML
.HTMLBody = head & body
.Send
End With
Next x
End Sub
Further to the above comments, #bamie9l has already solved one problem of yours
Problem 2
#bamie9l Awesome! That worked, but now at the .BodyFormat = olFormatHTML line I get Run-time error '5': Invalid procedure call or argument – metsales 13 mins ago
You are latebinding with Outlook from Excel and olFormatHTML is an Outlook constant and hence Excel is unable to recognize it. In the Immediate Window of MS-Outlook if you type ?olFormatHTML then you will note that the value of that constant is 2
Hence we have to declare that constant in Excel. Like I mentioned, either you can put Const olFormatHTML = 2 at the top of the code or replace .BodyFormat = olFormatHTML by .BodyFormat = 2
Problem 3
#SiddharthRout So that works, but now I get a crazy automation error... it goes through the loop once.. sends 1 email and then when it gets up to .subject = subject I get Run-time error '-2147221238 (8004010a)': Automation Error which as far as I know is the same as Run-Time Error 440 – metsales
The problem is that you are creating the outlook item outside the loop by
Set objMail = olApp.CreateItem(0)
Outlook already sent that email and now for the next email you will have to re-create it. So move that line inside the loop.
For x = 1 To 3
Set objMail = olApp.CreateItem(0)
head = "<HTML><BODY><P>Hi " & Cells(x, 1).Value & ",</P>"
Body = "Blah Blah"
With objMail
.subject = subject
.To = Cells(x, 2).Value
.Attachments.Add = FilePath & "/" & Cells(x, 3).Value
.Attachments.Add = FilePath & "/" & Cells(x, 4).Value
.BodyFormat = olFormatHTML
.HTMLBody = head & Body
.Send
End With
Next x

VBA Excel - If cell in one column contains email address and cell in another column is "SOLD" , send email

Just started experimenting with VBA today. Creating Excel sheet to track SOLD, PENDING, LOST that will allow salesmen to click a button to send a group email to one category at a time. After much searching I found some code that works well to send group email by checking a column to make sure a proper address is there. I found some other code that I thought would check the "Job Status" column so that only the "SOLD" or whatever would be chosen for email. I am a clueless beginner and need help. Here is the code that was working until I added the - If Sh.Cells(Target.Row, 7) = "PENDING" Then - part. Any help would be greatly appreciated. Thanks!
Private Sub CommandButton1_Click()
Dim cell As Range
Dim strto As String
For Each cell In ThisWorkbook.Sheets("Sales 2013").Range("E3:E500")
If cell.Value Like "?*#?*.?*" Then
If Sh.Cells(Target.Row, 7) = "PENDING" Then
strto = strto & cell.Value & ";"
End If
End If
Next cell
If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
On Error GoTo cleanup
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "Anchor Sales"
.Bcc = strto
.Subject = "Enter subject here"
.Body = "" ' EMPTY FOR NOW
'USE THIS FOR ENTERING NAMES OF RECIPIENTS IN BODY TEXT "here"
'"Dear" & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"Enter body text " & _
"here"
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
'.Send 'Or use Display
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
End Sub
Please help!
of course I would prefer to send one mail per Person (if the recipients shall not know each other), but let's stay with your Problem.
you only need minor changes:
Private Sub CommandButton1_Click()
Dim cell As Range
Dim strto As String
For Each cell In ThisWorkbook.Sheets("Sales 2013").Range("E3:E500")
If cell.Value = "PENDING" Then strto = strto & cell.offset(0, 1).value & ";"
I am not sure if you Need the part "If cell.Value Like "?#?.?*" " or if that is from copy-paste from the code you found... If you Need it, the last line would have to be replaced by
If cell.Value Like "?*#?*.?*" and cell.Value = "PENDING" Then strto = strto & cell.offset(0, 1).value & ";"
'in Offset(0,1) I assume the mailadress is in the cell next to the cell tested for "pending"
Next cell
If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)
the rest as you have it.
the Problem was caused by
If Sh.Cells(Target.Row, 7) = "PENDING" Then
as you have no definition for "sh" - but you also don't need it.
I hope this helps