testmacros
04-25-2016, 07:24 AM
Hi
With my code I was able to copy a selection to clip board, but however I am unable to paste it in the Outlook body. Once the outlook is open I am able to paste using Ctrl + V, but not able to do via macro. Could you please help as I am new and learning stuff.
Thank you for the help in advance.
Private Sub DraftEmail_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim ebody As String
Dim DataObj As MSForms.DataObject
Set DataObj = New MSForms.DataObject
Dim pastimg As Variant
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(O)
Sheet5.Activate
ebody = "Hello," & "<br><br>" & "            Please find the estimates for '" & Sheet5.Range("G3").Value & "' as below. Kindly provide your approval or let us know for any information." & vbNewLine
On Error Resume Next
Sheet13.Activate
Sheet13.Range("B3:E19").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
With OutMail
.Display
.Subject = "Approval Needed - " & Sheet5.Range("G3").Value & " - Estimated"
'.To = ""
.CC = ""
DataObj.GetFromClipboard
pastimg = DataObj.GetText
.HTMLBody = "<p style='font-family:Calibri;font-size:15'>" & ebody & "<br>" & pastimg & "<br>" & .HTMLBody
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Sheet5.Activate
End Sub
With my code I was able to copy a selection to clip board, but however I am unable to paste it in the Outlook body. Once the outlook is open I am able to paste using Ctrl + V, but not able to do via macro. Could you please help as I am new and learning stuff.
Thank you for the help in advance.
Private Sub DraftEmail_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim ebody As String
Dim DataObj As MSForms.DataObject
Set DataObj = New MSForms.DataObject
Dim pastimg As Variant
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(O)
Sheet5.Activate
ebody = "Hello," & "<br><br>" & "            Please find the estimates for '" & Sheet5.Range("G3").Value & "' as below. Kindly provide your approval or let us know for any information." & vbNewLine
On Error Resume Next
Sheet13.Activate
Sheet13.Range("B3:E19").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
With OutMail
.Display
.Subject = "Approval Needed - " & Sheet5.Range("G3").Value & " - Estimated"
'.To = ""
.CC = ""
DataObj.GetFromClipboard
pastimg = DataObj.GetText
.HTMLBody = "<p style='font-family:Calibri;font-size:15'>" & ebody & "<br>" & pastimg & "<br>" & .HTMLBody
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Sheet5.Activate
End Sub