title: Export from Excel to Outlook
body: <p>My workbook has 5 different sheets and I need to copy the five sheets and paste it into  5 different mails. Preferably as HTML.</p>
  
  <p>The below written code only attaches the different sheets to outlook. I need the HTML below the body of the email. Please note that my range in the sheets varies from workbook to workbook but the sheet names remain the same.</p>
  
  <pre><code>  Function BrowseForFolder(Optional OpenAt As Variant) As Variant
  'Function purpose: To Browser for a user selected folder.
  'If the "OpenAt" path is provided, open the browser at that directory
  'NOTE: If invalid, it will open at the Desktop level
  'BrowseForFolder was a code originally written by Ron De Bruin, I love this function!
  
  Dim ShellApp As Object
  
  'Create a file browser window at the default folder
  Set ShellApp = CreateObject("Shell.Application"). _
  BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
  
  'Set the folder to that selected. (On error in case cancelled)
  On Error Resume Next
  BrowseForFolder = ShellApp.self.Path
  On Error GoTo 0
  
  'Destroy the Shell Application
  Set ShellApp = Nothing
  
  'Check for invalid or non-entries and send to the Invalid error
  'handler if found
  'Valid selections can begin L: (where L is a letter) or
  '\\ (as in \\servername\sharename. All others are invalid
  Select Case Mid(BrowseForFolder, 2, 1)
  Case Is = ":"
  If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
  Case Is = "\"
  If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
  Case Else
  GoTo Invalid
  End Select
  
  Exit Function
  
  Invalid:
  'If it was determined that the selection was invalid, set to False
  BrowseForFolder = False
  
  End Function
  
  Sub SaveWorksheets()
  'saves each worksheet as a separate file in a specific folder.
  Dim ThisFolder As String
  Dim NameOfFile As String
  Dim Period As String
  Dim RecipName As String
  
  ThisFolder = BrowseForFolder()
  
  Application.ScreenUpdating = False
  
  Dim ws As Worksheet
  Dim wsName As String
  For Each ws In ActiveWorkbook.Worksheets
  wsName = ws.Name
  
  If wsName &lt;&gt; "Data" Then
  
  Period = ws.Cells(4, 1).Value 'put the row and column numbers of the report date here.
  RecipName = ws.Cells(1, 29).Value 'put the row and column numbers of the email address here
  NameOfFile = ThisFolder &amp; "\" &amp; "Termination Report " &amp; wsName &amp; " " &amp; Period &amp; ".xlsx"
  
  ws.Select
  ws.Copy
  ActiveWorkbook.SaveAs Filename:= _
  NameOfFile, FileFormat:= _
  xlOpenXMLWorkbook, CreateBackup:=False
  ActiveWindow.Close
  Call EmailWorkbooks(RecipName, NameOfFile)
  End If
  
  Next ws
  End Sub
  
  Sub EmailWorkbooks(RecipName, NameOfFile)
  
  Dim OutApp As Object
  Dim OutMail As Object
  
  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.createItem(0)
  
  Msg = "Attached is the xyz report for your review. Please let me know if you have any questions" &amp; vbCrLf &amp; vbCrLf _
  &amp; "Thanks," &amp; vbCrLf &amp; vbCrLf _
  &amp; "Your Name Here" &amp; vbCrLf _
  &amp; "Your Title" &amp; vbCrLf _
  &amp; "Your contact info"
  
  Subj = "XYZ Report" &amp; " " &amp; Period
  
  On Error Resume Next
  With OutMail
  .To = RecipName
  '.CC =
  .Subject = Subj
  .Body = Msg
  .Attachments.Add (NameOfFile)
  .Save
  End With
  On Error GoTo 0
  
  End Sub 
  </code></pre>