title: How to insert a table after body of e-mail and before signature?
body: <p>I am using a below code that is pasting a table from excel to the outlook file. However, right now the table is pasted on the very bottom of the email - after the signature.</p>
  
  <p>What I would like to achieve is to have the table inserted after a word "region." and before "Regards" - so before signature.</p>
  
  <pre><code>Dim FileExtStr As String
  Dim FileFormatNum As Long
  Dim Sourcewb As Workbook
  Dim Destwb As Workbook
  Dim sh As Worksheet
  Dim DateString As String
  Dim FolderName As String
  Dim myOutlook As Object
  Dim myMailItem As Object
  Dim mySubject As String
  Dim myPath As String
  Dim i As Integer
  With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlCalculationManual
  End With
  
  'Prompt for Email Subject
  
  Set outlApp = CreateObject("Outlook.Application")
  weeknumber = "Week " &amp; WorksheetFunction.WeekNum(Now, vbMonday)
  'mySubject = InputBox("Subject for Email")
  For i = 2 To 3
  region = Sheets("Sheet1").Cells(i, 5).Value
  mySubject = "Overdue Milestones | " &amp; weeknumber &amp; " | " &amp; region
  
  'Copy every sheet from the workbook with this macro
  Set Sourcewb = ActiveWorkbook
  'Create new folder to save the new files in
  DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
  FolderName = "C:\Users\mxr0520\Desktop\Ignite Reports\Milestones\" &amp; weeknumber
  If i &lt; 3 Then
  MkDir FolderName
  Else
  End If
  'Copy every visible sheet to a new workbook
  Set sh = Sheets(region)
      'If the sheet is visible then copy it to a new workbook
      If sh.Visible = -1 Then
          sh.Copy
          'Set Destwb to the new workbook
          Set Destwb = ActiveWorkbook
          'Determine the Excel version and file extension/format
          With Destwb
              If Val(Application.Version) &lt; 12 Then
                  'You use Excel 97-2003
                  FileExtStr = ".xls": FileFormatNum = -4143
              Else
                  'You use Excel 2007-2016
                  If Sourcewb.Name = .Name Then
                      MsgBox "Your answer is NO in the security dialog"
                      GoTo GoToNextSheet
                  Else
                      FileExtStr = ".xlsx": FileFormatNum = 51
                  End If
              End If
          End With
          'Change all cells in the worksheet to values if you want
          If Destwb.Sheets(1).ProtectContents = False Then
              With Destwb.Sheets(1).UsedRange
                  .Cells.Copy
                  .Cells.PasteSpecial xlPasteValues
                  .Cells(1).Select
              End With
              Application.CutCopyMode = False
          End If
          'Save the new workbook, email it, and close it
          'Set otlNewMail = outlApp.CreateItem(myMailItem)
  
          Set OutLookApp = CreateObject("Outlook.application")
          Set OutlookMailitem = OutLookApp.CreateItem(0)
              With OutlookMailitem
              .display
              End With
              Signature = OutlookMailitem.htmlbody
  
          With Destwb
              .SaveAs FolderName _
                    &amp; "\" &amp; Destwb.Sheets(1).Name &amp; FileExtStr, _
                      FileFormat:=FileFormatNum
          End With
          myPath = ActiveWorkbook.path &amp; "\" &amp; ActiveWorkbook.Name
          With Destwb
              .Close False
          End With
  
          With OutlookMailitem
              .Subject = mySubject
              .To = Sheets("Sheet1").Cells(i, 6)
              .CC = Sheets("Sheet1").Cells(i, 7)
              .htmlbody = "Dear All," &amp; "&lt;br&gt;" _
              &amp; "&lt;br&gt;" _
              &amp; "Attached please find the list of milestones that are &lt;b&gt;overdue&lt;/b&gt; and &lt;b&gt;due in 14 days&lt;/b&gt; for " &amp; region &amp; "." &amp; "&lt;br&gt;" &amp; "&lt;br&gt;" &amp; "Regards," &amp; "&lt;br&gt;" _
              &amp; "Marek" _
              &amp; Signature
              .Attachments.Add myPath
  
      Worksheets("Summary").Range("A1:E14").Copy
      Set vInspector = OutlookMailitem.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
          Set OutlookMailitem = Nothing
      End If
  </code></pre>
  
  <p>thank you for help in advance!</p>