title: Excel 2010 Paste Range and Picture into Outlook
body: <p>I am having considerable difficulty figuring this one out. I can paste a range as HTML without issues, but in some communications we want to past the range as a picture instead.  I can create a range and save it as a picture, but I cannot figure out how to past the picture into Outlook after it is created.</p>
  
  <p>If you are just looking for code that will copy a range and paste it into Outlook, this works great.  All of the email data is referencing cells on a tab called Mail, so you can simply copy and paste the Mail tab and the macro into any workbook and add email automation by editing the fields on the mail tab and not changing the macro.  If you use this code, make sure to reference Microsoft Outlook x.x Object Library (In VBA Window: Tools - References - Microsoft Outlook x.x Object Library).</p>
  
  <p>I need to take this one step further and be able to turn the range into a picture and paste it into the email. I can attach it, but I cannot insert it into the body, which is what I need.  I have looked at several examples, including those on Ron DeBruins website, but I have not been able to get any of them to work.  I am running Windows 7 x64 With Office 2010 x64.  </p>
  
  <p>Here is the code I am running to paste a range. </p>
  
  <pre><code>Option Explicit
  
  Sub Mail_AS_Range()
  
  ' Working in Office 2010-2013
  Dim OutApp As Outlook.Application
  Dim OutMail As Outlook.MailItem
  Dim strbody As String
  
  On Error Resume Next
  
  Dim sh As Worksheet
  Set sh = Sheets("Mail")
  strbody = sh.Range("C9").Value
  Sheets(sh.Range("C11").Value).Select
  ActiveWorkbook.Save
  
  
  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)
  With OutMail
      .SentOnBehalfOfName = sh.Range("C4")  'This allows us to send from an alternate email address
      .Display  'Alternate send address will not work if we do not display the email first.
                'I dont know why but this step is a MUST
      .To = sh.Range("C5")
      .CC = sh.Range("C6")
      .BCC = sh.Range("C7")
      .Subject = sh.Range("C8").Value
      .HTMLBody = "&lt;br&gt;" &amp; strbody &amp; fncRangeToHtml(sh.Range("C13").Value, sh.Range("C14").Value) &amp; .HTMLBody
                  ' This is where the body of the email is pulled together.
                  ' &lt;br&gt; is an HTML tag to turn the text into HTML
                  ' strbody is your text from cell C9 on the mail tab
                  ' fncRangetoHtml is converting the range you specified into HTML
                  ' .HTMLBody inserts your email signature
      .Attachments.Add sh.Range("C10").Value
      '.Send
  
  End With
  
  On Error GoTo 0
  
  Set OutMail = Nothing
  Set OutApp = Nothing
  
  End Sub
  
  
   Private Function fncRangeToHtml( _
   strWorksheetName As String, _
   strRangeAddress As String) As String
  
  ' This is creating a private function to make the range specified in the Mail macro into HTML
  
   Dim objFilesytem As Object, objTextstream As Object, objShape As Shape
   Dim strFilename As String, strTempText As String
   Dim blnRangeContainsShapes As Boolean
  
   strFilename = Environ$("temp") &amp; "\" &amp; _
       Format(Now, "dd-mm-yy_h-mm-ss") &amp; ".htm"
  
   ThisWorkbook.PublishObjects.Add( _
       SourceType:=xlSourceRange, _
       Filename:=strFilename, _
       Sheet:=strWorksheetName, _
       Source:=strRangeAddress, _
       HtmlType:=xlHtmlStatic).Publish True
  
   Set objFilesytem = CreateObject("Scripting.FileSystemObject")
   Set objTextstream = objFilesytem.GetFile(strFilename).OpenAsTextStream(1, -2)
   strTempText = objTextstream.ReadAll
   objTextstream.Close
   strTempText = Replace(strTempText, "align=center x:publishsource=", "align=left x:publishsource=")
  
   For Each objShape In Worksheets(strWorksheetName).Shapes
       If Not Intersect(objShape.TopLeftCell, Worksheets( _
           strWorksheetName).Range(strRangeAddress)) Is Nothing Then
  
           blnRangeContainsShapes = True
           Exit For
  
       End If
   Next
  
   If blnRangeContainsShapes Then strTempText = fncConvertPictureToMail(strTempText, Worksheets(strWorksheetName))
  
   fncRangeToHtml = strTempText
  
   Set objTextstream = Nothing
   Set objFilesytem = Nothing
  
   Kill strFilename
  
   End Function
  
   Public Function fncConvertPictureToMail(strTempText As String, objWorksheet As Worksheet) As String
  
   Const HTM_START = "&lt;link rel=File-List href="
   Const HTM_END = "/filelist.xml"
  
   Dim strTemp As String
   Dim lngPathLeft As Long
  
   lngPathLeft = InStr(1, strTempText, HTM_START)
  
   strTemp = Mid$(strTempText, lngPathLeft, InStr(lngPathLeft, strTempText, "&gt;") - lngPathLeft)
   strTemp = Replace(strTemp, HTM_START &amp; Chr$(34), "")
   strTemp = Replace(strTemp, HTM_END &amp; Chr$(34), "")
   strTemp = strTemp &amp; "/"
  
   strTempText = Replace(strTempText, strTemp, Environ$("temp") &amp; "\" &amp; strTemp)
  
   fncConvertPictureToMail = strTempText
  
   End Function
  </code></pre>
  
  <p>Any suggestions would be appreciated.  Thanks!</p>