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
Related
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".
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.
I have some undeliverable emails in a folder. I am trying to go through each email in the folder and pull out the intended recipients email address by searching the message.
I have some VBA code that works on regular emails, but since undeliverable's aren't Outlook "Mail Items", they are Outlook "Report Items", I am having issues searching the message. The search function is coming back empty and after a lot of research, it seems that maybe "Report Items" do not actually have a "body" that can be searched.
The email in all the error reports are in the following format in the report.
(xxxxxx#xxxxxx.com)
Here is the code I am using, which works on normal Mail Items.
Sub Undeliver()
On Error Resume Next
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("MAPI")
'Selects the current active folder to use
Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
'creates excel spreadsheet where data will go
Set xlobj = CreateObject("excel.application")
xlobj.Visible = True
xlobj.Workbooks.Add
'names column a row 1 "email" and column b row 1 "else"
xlobj.Range("a" & 1).Value = "Email"
xlobj.Range("b" & 1).Value = "Else"
'loops through all the items in the current folder selected
For I = 1 To myfolder.Items.Count
Set myitem = myfolder.Items(I)
'selects the body of the current email being searched
msgtext = myitem.Body
'searches the body for the first open parentheses and first close
'parentheses and copies the value in between into an array
delimtedMessage = Replace(msgtext, "(", "###")
delimtedMessage = Replace(delimtedMessage, ")", "###")
'splits the array up into two pieces
messageArray = Split(delimitedMessage, "###")
'this inputs the values of the array into my excel spreadsheet
xlobj.Range("a" & I + 1).Value = messageArray(1)
xlobj.Range("b" & I + 1).Value = messageArray(2)
Next I
End Sub
Does anyone know how I can access the message part of the report for searching purposes?
The solution I ended up going with involved converting the body of the message back to Unicode and then searching for what I needed. This ended up being very simple to implement.
Here is my finished, working code for future reference. I ended up adding a progress bar to monitor where it was in the code. It unfortunately runs fairly slow but it gets the job done.
Hopefully this helps someone in the future!
On Error Resume Next
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("MAPI")
Set xlobj = CreateObject("excel.application")
xlobj.Visible = True
xlobj.Workbooks.Add
xlobj.Range("a" & 1).Value = "Email"
xlobj.Application.displayStatusBar = True
For I = 1 To myOlApp.ActiveExplorer.CurrentFolder.Items.Count
Set myitem = myOlApp.ActiveExplorer.CurrentFolder.Items(I)
msgtext = StrConv(myitem.Body, vbUnicode)
delimtedMessage = Replace(msgtext, "mailto:", "###")
delimtedMessage = Replace(delimtedMessage, "</a><br>", "###")
messageArray = Split(delimtedMessage, "###")
xlobj.Range("a" & I + 1).Value = Split(messageArray(1), """")(0)
xlobj.Application.StatusBar = "Progress: " & I & " of " & myOlApp.ActiveExplorer.CurrentFolder.Items.Count & Format(I / myOlApp.ActiveExplorer.CurrentFolder.Items.Count, " 0%")
Next I
xlobj.Application.displayStatusBar = False
Well, there is always this solution.
The gist is that ReportItem.Body returns an unreadable string, so this solution saves the ReportItem as a text file, then parses the text file. Its not exactly elegant, but it should work.
Hope this helps!
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
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