title: Create email with contents in order: Text, Image, Text, Image, Text, Signature
body: <p>I am working in Excel. I want to draft an email in a specific format.</p>
  <p>I can't find anything where an email is in this format:</p>
  <ul>
  <li>Words</li>
  <li>Image</li>
  <li>Words</li>
  <li>Image</li>
  <li>Words</li>
  <li>Signature</li>
  </ul>
  <p>I found ones that are words, image, image and signature which I used to build mine.</p>
  <p>This is how it appears:<br />
  <a href="https://i.stack.imgur.com/XpR4B.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/XpR4B.png" alt="enter image description here" /></a></p>
  <p>This is how it should look:<br />
  <a href="https://i.stack.imgur.com/Ub5S4.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/Ub5S4.png" alt="enter image description here" /></a></p>
  <p>I left all I tried as commented out sections.</p>
  <pre class="lang-vb prettyprint-override"><code>Sub EmailGenerate()
      
      Dim objOutApp As Object, objOutMail As Object
      Dim strBody As String, strSig As String, strEnd As String, strBody2 As String
      Dim rng As Range, rng2 As Range
      Dim r As Long, r2 As Long
      Dim wdDoc As Word.Document
      Dim Selection As Word.Selection
      Dim Selection2 As Word.Selection
       
      r = shEmail.Cells(Rows.Count, 15).End(xlUp).Row
      Set rng = shEmail.Range(&quot;K1:&quot; &amp; Cells(r, 21).Address)
      
      r2 = shEmail.Cells(Rows.Count, 23).End(xlUp).Row
      Set rng2 = shEmail.Range(&quot;W1:&quot; &amp; Cells(r2, 29).Address)
      
      Set objOutApp = CreateObject(&quot;Outlook.Application&quot;)
      Set objOutMail = objOutApp.CreateItem(0)
      Set wdDoc = objOutMail.GetInspector.WordEditor
       
      With objOutMail
          'If sent on behalf of another email address
          ' .SentOnBehalfOfName = &quot;&quot;
          'Setting the email conditions
          .To = shEmail.Cells(1, 2).Value
          .CC = shEmail.Cells(2, 2).Value
          .BCC = &quot;&quot;
          'Checks all email names
          .Recipients.ResolveAll
          .Subject = shEmail.Cells(4, 2).Value
          'This must be visible to get the default signature
          .Display
          'Get the html code from the signature
          strSig = .htmlbody
          'This is what the email body should say
        
         ' rng.Copy
         ' wdDoc.Application.Selection.Start = Len(strBody)
         ' wdDoc.Application.Selection.End = wdDoc.Application.Selection.Start
         ' wdDoc.Application.Selection.PasteAndFormat (wdChartPicture)
         ' wdDoc.Content.InsertParagraphAfter
         ' rng2.Copy
         ' wdDoc.Application.Selection.Start = Len(strBody) + Len(strBody2)
         ' wdDoc.Application.Selection.End = wdDoc.Application.Selection.Start
         ' wdDoc.Application.Selection.PasteAndFormat (wdChartPicture)
        
         ' rng1.Copy
         ' wdDoc.Paragraphs(2).Range.PasteSpecial , , , , wdPasteBitmap
        
          rng.Copy
          wdDoc.Content.InsertParagraphBefore
          wdDoc.Paragraphs(2).Range.PasteSpecial , , , , wdPasteBitmap
          wdDoc.Content.InsertParagraphAfter
        
          strBody = &quot;&lt;Body style=font-size:11pt;font-family:Calibri&gt;&quot; &amp; _
            shEmail.Cells(5, 2).Value &amp; &quot;&lt;/p&gt;&quot; &amp; _
            &quot;&lt;p&gt;&quot; &amp; &quot;&lt;/p&gt;&quot; &amp; _
            &quot;&lt;p&gt;&quot; &amp; shEmail.Cells(6, 2).Value &amp; &quot;&lt;/p&gt;&quot; &amp; _
            &quot;&lt;p&gt;&quot; &amp; shEmail.Cells(7, 2).Value &amp; &quot;&lt;/p&gt;&quot; &amp; _
            &quot;&lt;p&gt;&quot; &amp; &quot;&lt;/p&gt;&quot; &amp; _
            &quot;&lt;p&gt;&quot; &amp; shEmail.Cells(8, 2).Value &amp; &quot;&lt;/p&gt;&quot;
            
          strBody2 = &quot;&lt;Body style=font-size:11pt;font-family:Calibri&gt;&quot; &amp; _
            shEmail.Cells(10, 2).Value &amp; &quot;&lt;/p&gt;&quot; &amp; _
            &quot;&lt;p&gt;&quot; &amp; &quot;&lt;/p&gt;&quot;
         
          rng2.Copy
          wdDoc.Content.InsertParagraphBefore
          wdDoc.Paragraphs(1).Range.PasteSpecial , , , , wdPasteBitmap
          wdDoc.Content.InsertParagraphAfter
          
          objOutMail.htmlbody = strBody2 &amp; _
            .htmlbody
           
          ' rng2.Copy
          ' wdDoc.Application.Selection.Start = Len(strBody) + Len(strBody2)
          ' wdDoc.Application.Selection.End = wdDoc.Application.Selection.Start
          ' wdDoc.Application.Selection.PasteAndFormat (wdChartPicture)
      
          'Combines the email with image and the signature
          objOutMail.htmlbody = strBody &amp; _
            .htmlbody
        
          'Automatically sends the email, should pop up briefly.
          '.Send
      
      End With
      
      On Error GoTo 0
      Set objOutMail = Nothing
      Set objOutApp = Nothing
       
  End Sub
  </code></pre>
  <p>rng is the larger table and rng2 is the smaller table.</p>
  <p>.Cells(5,2) through to (8,2) go before rng and (10,2) goes after rng and before rng2 then (12,2) would go after rng2 and before the signature.</p>