robovacuum_2
New Member
- Joined
- Feb 2, 2020
- Messages
- 3
- Office Version
- 365
- Platform
- Windows
Hi all,
I am trying to paste a range from excel - the range area includes both cells with data in them and a share price graph - into an automated e-mail as an image using VBA
Usually, I right click and paste as image
I have the following code, which is writing the e-mail and pasting the image below the text body, but unfortunately, the formatting is not legible when pasted as a cell range rather than image in outlook/email
Please see my current code below - appreciate any help that can be provided!
------------------------------------------------------------------------------------------
1) Pastes the link to the image but not the image itself
Sub SendEmail1()
'Generate e-mail with attachments
Dim Outapp As Object
Dim outmail As Object
Dim files As String
Dim main_body As String
Dim mess_body As String, StrFile As String, StrPath As String
main_body = Worksheets("BB (dynamic)").Range("B10").Value
StrPath = "c:\Users\Desktop\Today\"
Set Outapp = CreateObject("outlook.application")
Set outmail = Outapp.CreateItem(0)
With outmail
.To = Worksheets("BB (dynamic)").Range("C2").Value
.CC = Worksheets("BB (dynamic)").Range("C3").Value
.BCC = Worksheets("BB (dynamic)").Range("C4").Value
.Subject = Worksheets("BB (dynamic)").Range("C5").Value
.attachments.Add ("c:\Users\Desktop\TestImage.JPEG"), olbyvalue, 0
StrFile = Dir(StrPath & "*.*")
Do While Len(StrFile) > 0
.attachments.Add StrPath & StrFile
StrFile = Dir
Loop
.body = main_body _
& "<img src='c:\Users\Desktop\TestImage.JPEG'" & "width='814' height='33'><br>"
.display
End With
End Sub
2) Pastes the image in body (but not as JPEG)
With outmail
.To = Worksheets("Email").Range("C4").Value
.CC = Worksheets("Email").Range("C5").Value
.BCC = Worksheets("Email").Range("C6").Value
.Subject = Worksheets("Email").Range("C7").Value
StrFile = Dir(StrPath & "*.*")
Do While Len(StrFile) > 0
.attachments.Add StrPath & StrFile
StrFile = Dir
Loop
strfile1 = Dir(strpath1 & "*.*")
Do While Len(strfile1) > 0
.attachments.Add strpath1 & strfile1
strfile1 = Dir
Loop
.body = main_body & vbCrLf
Worksheets("Output").Range("B2:L46").Copy
Set vinspector = outmail.getinspector
Set weditor = vinspector.wordeditor
weditor.Application.Selection.Start = Len(.body)
weditor.Application.Selection.End = weditor.Application.Selection.Start
weditor.Application.Selection.Paste
.display
End With
End Sub
I am trying to paste a range from excel - the range area includes both cells with data in them and a share price graph - into an automated e-mail as an image using VBA
Usually, I right click and paste as image
I have the following code, which is writing the e-mail and pasting the image below the text body, but unfortunately, the formatting is not legible when pasted as a cell range rather than image in outlook/email
Please see my current code below - appreciate any help that can be provided!
------------------------------------------------------------------------------------------
1) Pastes the link to the image but not the image itself
Sub SendEmail1()
'Generate e-mail with attachments
Dim Outapp As Object
Dim outmail As Object
Dim files As String
Dim main_body As String
Dim mess_body As String, StrFile As String, StrPath As String
main_body = Worksheets("BB (dynamic)").Range("B10").Value
StrPath = "c:\Users\Desktop\Today\"
Set Outapp = CreateObject("outlook.application")
Set outmail = Outapp.CreateItem(0)
With outmail
.To = Worksheets("BB (dynamic)").Range("C2").Value
.CC = Worksheets("BB (dynamic)").Range("C3").Value
.BCC = Worksheets("BB (dynamic)").Range("C4").Value
.Subject = Worksheets("BB (dynamic)").Range("C5").Value
.attachments.Add ("c:\Users\Desktop\TestImage.JPEG"), olbyvalue, 0
StrFile = Dir(StrPath & "*.*")
Do While Len(StrFile) > 0
.attachments.Add StrPath & StrFile
StrFile = Dir
Loop
.body = main_body _
& "<img src='c:\Users\Desktop\TestImage.JPEG'" & "width='814' height='33'><br>"
.display
End With
End Sub
2) Pastes the image in body (but not as JPEG)
With outmail
.To = Worksheets("Email").Range("C4").Value
.CC = Worksheets("Email").Range("C5").Value
.BCC = Worksheets("Email").Range("C6").Value
.Subject = Worksheets("Email").Range("C7").Value
StrFile = Dir(StrPath & "*.*")
Do While Len(StrFile) > 0
.attachments.Add StrPath & StrFile
StrFile = Dir
Loop
strfile1 = Dir(strpath1 & "*.*")
Do While Len(strfile1) > 0
.attachments.Add strpath1 & strfile1
strfile1 = Dir
Loop
.body = main_body & vbCrLf
Worksheets("Output").Range("B2:L46").Copy
Set vinspector = outmail.getinspector
Set weditor = vinspector.wordeditor
weditor.Application.Selection.Start = Len(.body)
weditor.Application.Selection.End = weditor.Application.Selection.Start
weditor.Application.Selection.Paste
.display
End With
End Sub