I'm using outlook 2016 and Excel 2016. I have written a code to paste a email in the outlook body. My email body contains html codes which has image included,the code works fine however I'm not able to paste the image in the email body. Please help.
Please find the vba code below.
Sub Send_Mails()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim subj As String
Dim recp As String
Dim bccrep As String
Dim ccrecp As String
Dim i As Integer
For i = 2 To 10
Sheets("Email Draft").Select
strbody = Sheets("Email Draft").Range("C1")
subj = "Welcome - " & Sheets("Macro").Range("O" & i)
recp = Sheets("Macro").Range("I" & i)
ccrecp = Sheets("Macro").Range("J" & i)
bccrep = Sheets("Macro").Range("K" & i)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = recp
.CC = ccrecp
.BCC = bccrep
.Subject = subj
.HTMLBody = .HTMLBody & strbody
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
Next i
End Sub
If you appending HTML to the existing HTML message body you are likely adding content outside of the element and it won't be visible. You have to modify what is in the element. As an alternative to manipulating the HTML string, you can use the Word Object Model to change the body content via Inspector.WordEditor.
Related
I try to ask my questions here 'cause I don't find any answer to my problems anywhere.
I try to send an email in vba from my excel using outlook signature but I get a 62 error.
This is the code I used, that works fine in another Excel worksheet and works fine in it, but not in my other worksheet.
Dim FSO As Scripting.FileSystemObject
Dim TextStream As Scripting.TextStream
Dim file_name As String
dim signature_name as string
dim signature as string
signature_name = Sheets("Parameter").Range("A2").Value
signature = ""
Set FSO = Nothing
Set TextStream = Nothing
Set FSO = New Scripting.FileSystemObject
file_name = Environ("APPDATA") & "\Microsoft\Signatures\" & signature_name & ".htm"
Set TextStream = FSO.OpenTextFile(file_name, ForReading, False, TristateMixed)
If Err.Num = 0 Then
signature = TextStream.ReadAll
signature = Replace(signature, signature_name & "_files/", Environ("APPDATA") & "\Microsoft\Signatures\" & signature_name & "_files/")
End if
I checked with checkpoint what file_name contained and it contained the right path to the signature files.
But still, when I try to OpenTextFile, I get an atEndOfLine = true and atEndOfStream = true
I hope you guys could help me 'cause I get stuck since two weeks on this problem :D
Thanks for your time
H.
I try checkpoint, debugging, différents signature, copy/paste several codes
When I check the err.num value, it returns me 438...
I was having trouble getting my signature from "\Microsoft\Signatures\" or whatever address I was using. Something to do with the server I was on.
Anyway, I found this solution and it's been working for me consistently (as long as it's only your "default" signature you want:
Sub Build_And_Send_Email()
Dim objOutlook As Object
Dim objEmail As Object
Dim objAttachment As Object
`...
'Setup Email
Set objOutlook = CreateObject("Outlook.Application")
Set objEmail = objOutlook.CreateItem(olMailItem)
'when displayed with no content, it inputs default signature
objEmail.Display
Set objAttachment = objEmail.Attachments
objAttachment.Add "S:\Attachment Directory.pdf"
eSubject = " My Subject "
eBody = " Some text using html control for stuff like <br> line breaks "
'Build Email
With objEmail
.To = eRecipient
.CC = ""
.BCC = ""
.Subject = eSubject
' > Signature already included in .HTMLBody
.HTMLBody = eBody & .HTMLBody
.BodyFormat = olFormatHTML ' send plain text message
'.Display
'.Send
End With
End Sub
I use this everyday for multiple reports. Seems to work on multiple computers. I hope it works for you.
I am trying to add Excel data to Outlook email.
This is an illustration of the output in an Outlook email editor. The img I'm trying to add should be add at the end, after the Excel content.
I tried various ways to add an image which is a footnote.
I tried adding the <img> tag to attach it as HTML attachment but it gets attached without any spacing.
Tried using these two lines initially
.Attachments.Add "C:\Users\Sumit Jain\Pictures\11\city.jpg", olByValue, 0
.HTMLBody = .HTMLBody & "<img src='cid:city.jpg'><br>"
Then I tried making a default signature in Outlook.
The code
.HTMLBody = "<HTML><body><body></HTML>" & .HTMLBody
appends Outlook's default signature on the top and then the Excel content after.
Reference to page I used the logic from Link
Below is the code
Private Sub CommandButton9_Click()
On Error GoTo ERRORMSG
Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Set otlApp = CreateObject("Outlook.Application")
Set olMail = otlApp.CreateItem(olMailItem)
Set Doc = olMail.GetInspector.WordEditor
Set mainWB = ActiveWorkbook
mainWB.Sheets("Mail").Range("m8").Value = ComboBox4.Value
mainWB.Sheets("Mail").Range("n8").Value = TextBox40.Value
mainWB.Sheets("Mail").Range("q8").Value = ComboBox5.Value
mainWB.Sheets("Mail").Range("r8").Value = ComboBox6.Value
mainWB.Sheets("Mail").Range("s8").Value = ComboBox7.Value
mainWB.Sheets("Mail").Range("t8").Value = TextBox44.Value
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
On Error GoTo 0
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = mainWB.Sheets("Email").Range("A3").Value
.cc = mainWB.Sheets("Mail").Range("L12").Value
.Subject = mainWB.Sheets("Mail").Range("O15").Value
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
'force html format
.HTMLBody = "<HTML><body><body></HTML>" & .HTMLBody
.Display
'--- start with 6 CrLf's, so we can place each table
' above all but the last used...
oRng.InsertAfter vbCrLf & vbCrLf
'--- now reselect the entire document, collapse our cursor to the end
' and back up one character (so that the table inserts before the SIXTH CrLf)
Set oRng = wdDoc.Range
oRng.collapse 0
oRng.Move 1, -1
Range("K3:T10").Select
Selection.Copy
oRng.Paste
'--- finally move the cursor all the way to the end and paste the
' second table BELOW the SIXTH CrLf
Set oRng = wdDoc.Range
oRng.collapse 0
Range("K38:T46").Select
Selection.Copy
oRng.Paste
End With
Exit Sub
End Sub
Try the following in your code....
You need to add Mysig.htm to the name of your signature
SigString = Environ("appdata") & "\Microsoft\Signatures\" & UOutLookSign & ".htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
I have a VBA set of code that generates an email and automatically sends it.
One of the things that I cannot get to work properly is putting a hyperlink to a specified folder location within the email.
Dim fpath As String
fpath = Worksheets("MS_JRNL_OPEN_TU_FR-4333635").Range("AD5").Value
"file://" & fpath & _
Essentially the user has to input a folder location when running the Macro which is in Cell AD5, but I want this is appear as the full folder location as a hyperlink once the email is generated.
Any help would be greatly appreciated
If you are currently using HTMLBody in your email code, it's quite easy to do. I'll assume you are using code similar to below. Take note of strbody and .HTMLBody. Assuming your fpath is formatted like C:\Users\tjb1\Desktop\file.docx then you don't need to add anything else to it. The section creating the hyperlink is "test link". You can change test link to say whatever you want or change the line to "" & fpath & "" to use the path as the link text.
Sub MailURL()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "test link"
On Error Resume Next
With OutMail
.To = "APerson#Somewhere.com"
.Subject = "Testing URL"
.HTMLBody = strbody
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I found the code above at MrExcel and just formatted it a bit to work with your variable.
I can send a single Outlook message using Excel VBA. However, I want to loop through my rows and send an email for each row that meets a certain condition.
Unfortunately, when I put the email code in a for loop only one email gets sent or none at all (depending on how I structure the code).
Is there something about calling Outlook multiple times that I should know?
Private Sub CommandButton1_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim myValue As Variant
Dim contactRange As Range
Dim cell As Range
Dim toAddy As String, nextAddy As String
Dim i As Integer
Set contactRange = Me.Range("ContactYesNo")
myValue = InputBox("Enter body of email message.")
For Each cell In contactRange
If Range(Cells(cell.Row, cell.Column).Address).Value = "Yes" Then
nextAddy = Range(Cells(cell.Row, cell.Column).Address).Offset(0, 5).Value
toAddy = nextAddy & ", " & toAddy
End If
Next cell
If Len(toAddy) > 0 Then
toAddy = Left(toAddy, Len(toAddy) - 2)
End If
For i = 0 To 1 'short loop for testing purposes
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = toAddy
.CC = ""
.BCC = ""
.Subject = "test email"
.Body = myValue
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
Next i
End Sub
Take the CreateObject line out of the loop:
Set OutApp = CreateObject("Outlook.Application")
For i = 0 To 1 'short loop for testing purposes
Set OutMail = OutApp.CreateItem(0)
...
I've tried to clean up your logic stream but there are many unanswered questions due to the lack of sample data, explicit error messages and output.
Private Sub CommandButton1_Click()
Dim outApp As Object
Dim outMail As Object
Dim myValue As Variant
Dim contactRange As Range
Dim cell As Range
Dim toAddy As String, nextAddy As String
Dim i As Integer
Set outApp = CreateObject("Outlook.Application")
Set contactRange = Me.Range("ContactYesNo")
myValue = InputBox("Enter body of email message.")
With Worksheets(contactRange.Parent.Name) '<~~ surely you know what worksheet you are on..!?!
For Each cell In contactRange
If cell.Value = "Yes" Then 'no need to define a range by the range's address
nextAddy = cell.Offset(0, 5).Value 'again, no need to define a range by the range's address
toAddy = nextAddy & ";" & toAddy 'use a semi-colon to concatenate email addresses
End If
Next cell
End With
If Len(toAddy) > 0 Then
toAddy = Left(toAddy, Len(toAddy) - 2) 'I have no idea why you need to shorten the toAddy by 2
'only send mail where one or more addresses exist
For i = 0 To 1 'short loop for testing purposes
Set outMail = outApp.CreateItem(0)
With outMail
.To = toAddy
.CC = ""
.BCC = ""
.Subject = "test email"
.Body = myValue
.Send
End With
Set outMail = Nothing
Next i
End If
Set outApp = Nothing
End Sub
OK, so I re-wrote the code based on the feedback. I used a loop to send emails one at a time instead of concatenating the addresses together as I wanted to personalize each email. I also needed to create a form to handle the input as inputbox only accepts 256 characters.
A form was pretty much required as I needed to capture the subject line, message body, salutation, path the to the attachment etc.:
Private Sub CommandButton1_Click()
Dim subject As String, msg As String, path As String
subject = TextBox1.Value
msg = TextBox2.Value & vbCrLf & vbCrLf & "Sincerely," & vbCrLf & TextBox4.Value & vbCrLf & TextBox5
path = TextBox3.Value
UserForm1.Hide
Module1.sendEmail subject, msg, path
End Sub
I placed the email code in Module1. Note, be sure to set the .sentOnBehalfOfName attribute or Outlook will simply pick an account which may not be the one you want if you have multiple accounts registered:
Public Sub sendEmail(subject As String, msg As String, path As String)
Dim outApp As Object
Dim outMail As Object
Dim contactRange As Range, cell As Range
Dim toAddy As String, emailMsg As String
Dim count As Integer
Set outApp = CreateObject("Outlook.Application")
Set contactRange = Range("ContactYesNo")
With Worksheets("IT consulting")
For Each cell In contactRange
If cell.Value = "Yes" Then
count = count + 1
toAddy = cell.Offset(0, 6).Value
emailMsg = "Dear " & cell.Offset(0, 2).Value & "," & vbCrLf & vbCrLf & msg
Set outMail = outApp.CreateItem(0)
With outMail
.SentOnBehalfOfName = "me#someemail.com"
.To = toAddy
.CC = ""
.BCC = ""
.subject = subject
.Body = emailMsg
.Attachments.Add path
'.Display
.Send
End With
'log the action
cell.Offset(0, 1).Value = Now & vbCrLf & cell.Offset(0, 1).Value
End If
Set outMail = Nothing
Next cell
End With
Set outApp = Nothing
MsgBox "total emails sent: " & count
End Sub
I have a macro for Outlook where I can create a complete mail with an attachment but can not add a signature saved in my C drive (C:\Users\JustinG\AppData\Roaming\Microsoft\Signatures).
Signature types are .rtf and .htm with images.
The following is the code:
Sub Mail_Workbook_1()
Dim OutApp As Object
Dim Outmail As Object
Set OutApp = CreateObject("Outlook.Application")
Set Outmail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
With Outmail
.SentOnBehalfOfName = "justin.gatlin#rediffmail.com"
.To = "abc#xyz.com"
.CC = ""
.BCC = ""
.Subject = "Presentation"
.Body = "Hi Team,"
.Attachments.add ("C:\Users\DurshetwarA\Desktop\Excel Examination_Master_V1.xlsx")
.display
''SendKeys ("%s")
End With
On Error GoTo 0
Set Outmail = Nothing
Set OutApp = Nothing
End Sub
In the .htm file in the signatures directory you can edit the htm file. The pictures are stored as relative path and when you use the code it looses that path so if you use discrete path it will be able to find the pictures. so go into the file and look for any relative paths and make them discrete.
"/Microsoft/Signatures/picturefile.jpg"
change that to include the whole path
"/root/user/blah blah../Microsoft/Signatures/picturefile.jpg"
This solved the missing image problem for me.
Solution described here by Ron de Bruin.
Sub Mail_Outlook_With_Signature_Html_2()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim SigString As String
Dim Signature As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<H3><B>Dear Customer Ron de Bruin</B></H3>" & _
"Please visit this website to download the new version.<br>" & _
"Let me know if you have problems.<br>" & _
"Ron's Excel Page" & _
"<br><br><B>Thank you</B>"
'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & _
"\Microsoft\Signatures\Mysig.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = strbody & "<br>" & Signature
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
Instead of .body use .htmlbody and design your message body in HTML. This is the only way of inserting image in your message. There is no specific option to insert signature
Similar to the solution posted by Adavid02, here you may find a more detailed explanation.