title: Copy range of cells from Excel as picture and add text in the email body
body: <p>I'm tying to add range of cells as a picture from the active workbook along with some text.</p>
  
  <p>But for some reason it skipping the text and only pasting the image in the email body. </p>
  
  <p>How do I  fix this?</p>
  
  <pre><code>Option Explicit
  Public Sub POSTRUN()
  Dim olApp As Outlook.Application
  Set olApp = New Outlook.Application
  
  Dim Olobj As Outlook.Application
  Set Olobj = CreateObject("Outlook.Application")
  
  
  Dim olNs As Outlook.Namespace
  Set olNs = olApp.GetNamespace("MAPI")
  
  Dim Inbox  As Outlook.MAPIFolder
  Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
  
  Dim subject As String
      subject = ThisWorkbook.Sheets("SendMail").Range("I5").Text
      Debug.Print subject
  
  
  
  Dim i As Long
  Dim Filter As String
      Filter = "@SQL=" &amp; Chr(34) &amp; "urn:schemas:httpmail:datereceived" &amp; _
                         Chr(34) &amp; " &gt;= '01/01/1900' And " &amp; _
                         Chr(34) &amp; "urn:schemas:httpmail:datereceived" &amp; _
                         Chr(34) &amp; " &lt; '12/31/2100' And " &amp; _
                         Chr(34) &amp; "urn:schemas:httpmail:subject" &amp; _
                         Chr(34) &amp; "Like '%" &amp; subject &amp; "%'"
  
  Dim Items As Outlook.Items
  Set Items = Inbox.Items.Restrict(Filter)
      Items.Sort "[ReceivedTime]", False
  
  For i = Items.Count To 1 Step -1
      DoEvents
      If TypeOf Items(i) Is MailItem Then
          Dim Item As Object
          Set Item = Items(i)
          Debug.Print Item.subject ' Print on Immediate Window
          Debug.Print Item.ReceivedTime ' Print on Immediate Window
  
          Dim r As Range
          Set r = ThisWorkbook.Sheets("post").Range("A1:M30")
          r.Copy
  
          Dim outMail As Outlook.MailItem
          Set outMail = Olobj.CreateItem(olMailItem)
           Dim body
  
  
          Dim ReplyAll As Outlook.MailItem
          Set ReplyAll = Item.ReplyAll
           Dim wordDoc As Word.Document
          Set wordDoc = ReplyAll.GetInspector.WordEditor
  
          With ReplyAll
  
  
               .HTMLBody = "&lt;font size=""3"" face=""Calibri""&gt;" &amp; _
                "Hi  &lt;br&gt;&lt;br&gt;" &amp; _
                "The " &amp; Left(ActiveWorkbook.Name, _
                        InStr(ActiveWorkbook.Name, ".") - 1) &amp; _
                "&lt;/B&gt; has been posted.&lt;br&gt;" &amp; _
                .HTMLBody
  
                wordDoc.Range.PasteAndFormat wdChartPicture
  
               .Display
              Exit For
  
          End With
  
        End If
        Next
  
        End Sub
  </code></pre>