I was able to get the create email option working with this code:
Option Explicit
Public Const olMailItem = 0
Public Sub Create_Outlook_Email()
Dim lastRow As Long
Dim tempSheet As Worksheet
Dim r As Long, c As Long
Dim HTML As String
Dim OutApp As Object 'Outlook.Application
Dim OutEmail As Object 'Outlook.MailItem
With ActiveSheet
'Filter active sheet on columns A:I where column A is not blank
Application.ScreenUpdating = False
.AutoFilterMode = False
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A1:I" & lastRow).AutoFilter Field:=1, Criteria1:="<>"
'Add a temporary sheet and copy filtered rows to it
Set tempSheet = ThisWorkbook.Worksheets.Add
.AutoFilter.Range.Copy tempSheet.Range("A1")
.AutoFilterMode = False
Application.ScreenUpdating = True
End With
'Loop through rows and columns A:I on temporary sheet and construct HTML table
HTML = ""
HTML = HTML & "<br>"
HTML = HTML & "<table border='1' cellspacing='0' cellpadding='5' style='font-family:arial; font-size:10'>" & vbCrLf
HTML = HTML & "<tbody>" & vbCrLf
With tempSheet
'Row 1 - column headings
HTML = HTML & "<tr style='background-color:#0000FF; color:#FFFFFF'>"
For c = 1 To 9
HTML = HTML & "<td>" & .Cells(1, c).Value & "</td>"
Next
HTML = HTML & "</tr>" & vbCrLf
'Rows 2 to end - data rows
For r = 2 To .UsedRange.Rows.Count
HTML = HTML & "<tr>"
For c = 1 To 9
HTML = HTML & "<td>" & .Cells(r, c).Value & "</td>"
Next
HTML = HTML & "</tr>" & vbCrLf
Next
End With
HTML = HTML & "</tbody>" & vbCrLf
HTML = HTML & "</table>" & vbCrLf
HTML = HTML & "<br>"
'Delete the temporary sheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
tempSheet.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set OutApp = CreateObject("Outlook.Application") 'New Outlook.Application
Set OutEmail = OutApp.CreateItem(olMailItem)
'Create email with the HTML table and display the email
With OutEmail
'.To = "email.address1@email.com"
'.CC = "email.address2@email.com"
'.Subject = "Email subject"
.HTMLBody = HTML
.Display
End With
Set OutEmail = Nothing
Set OutApp = Nothing
End Sub
now just looking for the transfer when complete option.