This is a macro I made awile ago to send Excel data via Outlook

It has signature code that you might find useful

It's most likely not perfect ( )so if Graham has suggestions, I'll be glad to take them


'   ver 03  10/26/2018
'       added existance checks
'       made into function, True if successful
'   ver 02  10/25/2018
'       added sSignatures

Option Explicit
Option Private Module
Const olFormatHTML As Long = 2
Const olFormatPlain As Long = 1
Const olFormatRichText As Long = 3
Const olFormatUnspecified As Long = 0
Const olAppointmentItem As Long = 1
Const olContactItem As Long = 2
Const olDistributionListItem As Long = 7
Const olJournalItem As Long = 4
Const olMailItem As Long = 0
Const olNoteItem As Long = 5
Const olPostItem As Long = 6
Const olTaskItem As Long = 3
Const sDefaultSignature As String = "My Sig.htm"


Dim sSignatureFolder As String, sSignatureFile As String


'Signatures stored in  Environ("appdata") & "\Microsoft\Signatures\"
'If NO signature files, generate plain text email and plain text signature
'If 1 signature file, use the .HTM version as signature and generate HTML email
'if more than 1
'       use "My Sig.htm" if avaialble
'       otherwise generate plain text email and plain text signature
Function SendWithOutlook(emailRecipient As String, _
    emailMessage As String, _
        Optional emailSubject As String = vbNullString, _
            Optional emailAttachmentFile As String = vbNullString) As Boolean
    
    Dim oOutlook As Object
    Dim oMailItem As Object
    Dim sSignature As Variant
    Dim MailFormat As Long
    Dim sHtmlBody As String, sPlainBody As String
    On Error GoTo EmailError
    'see if attachment is there, raise error if not
    If Len(emailAttachmentFile) > 0 Then
        If Len(Dir(emailAttachmentFile)) = 0 Then Err.Raise vbObject + 1
    End If

    'see if Signature file is there, raise error if not
    sSignatureFolder = Environ("appdata") & "\Microsoft\Signatures\"
    If Len(Dir(sSignatureFolder)) = 0 Then Err.Raise vbObject + 2
    'get sSignature as text or the count number if not exactly 1
    sSignature = Sigs
    
    If IsNumeric(sSignature) Then
        If sSignature = 0 Then   '   no sSignatures
            MailFormat = olFormatPlain
            
        Else    'if more than one, does default exist (My Sig.htm)
            sSignatureFile = Dir(sSignatureFolder & sDefaultSignature)
            If Len(sSignatureFile) = 0 Then   '   if not, then plain text email
                MailFormat = olFormatPlain
                    
            Else
                MailFormat = olFormatHTML
            End If
        End If
        
    Else
        MailFormat = olFormatHTML
    End If
    
    
    'build signatures and format body as HTML or as Plain Text
    If MailFormat = olFormatHTML Then
        sSignature = CreateObject("Scripting.FileSystemObject").GetFile(sSignature).OpenAsTextStream(1, -2).readall
        
        sHtmlBody = emailMessage & "<hr>Sent " & FormatDateTime(Now, vbLongDate) & " at " & FormatDateTime(Now, vbLongTime) & "<hr><br>"
        sHtmlBody = Replace(sHtmlBody, "^", "<br>")
    
    Else
        sSignature = vbCrLf & vbCrLf & _
                    "--------------------------------------------------------------------------" & _
                    vbCrLf & vbCrLf & _
                    Application.UserName & _
                    vbCrLf & vbCrLf & _
                    "Sent " & FormatDateTime(Now, vbLongDate) & " at " & FormatDateTime(Now, vbLongTime)
        sPlainBody = Replace(emailMessage, "^", vbCrLf)
    End If

    'Set Outlook to current instance, opening if necessary
    Set oOutlook = GetObject(, "Outlook.Application")
    
    'create new mail item
    Set oMailItem = oOutlook.CreateItem(olMailItem)
    With oMailItem
        'Returns or sets a semicolon-delimited String list of display names for the To recipients for the Outlook item. Read/write.
        .To = emailRecipient
        .CC = vbNullString
        .BCC = vbNullString
        If Len(emailSubject) = 0 Then
            .Subject = ThisWorkbook.Name & " -- " & Format(Now, "General Date")
        Else
            .Subject = emailSubject
        End If
        If MailFormat = olFormatHTML Then
            .BodyFormat = MailFormat
            .HtmlBody = sHtmlBody & sSignature
        
        Else
            .BodyFormat = MailFormat
            .Body = sPlainBody & sSignature
        End If
        If Len(emailAttachmentFile) > 0 Then .Attachments.Add emailAttachmentFile
        
        .readreceiptrequested = False
        .Send
    End With
    On Error GoTo 0
    Set oMailItem = Nothing
    Set oOutlook = Nothing
    
    SendWithOutlook = True
    Exit Function
    
EmailError:
    If Err.Number = 429 Then
        Set oOutlook = CreateObject("Outlook.Application")
        Resume Next
    Else
        SendWithOutlook = False
        Set oMailItem = Nothing
        Set oOutlook = Nothing
    End If
 
 End Function

'if only one sSignature then return the path, if 0 or more than 1, return the count
 Function Sigs() As Variant
    Dim N As Long
    sSignatureFile = Dir(sSignatureFolder & "*.htm")
    Do While Len(sSignatureFile) > 0
        N = N + 1
        sSignatureFile = Dir
    Loop
    If N = 1 Then
        Sigs = sSignatureFolder & Dir(sSignatureFolder & "*.htm")
    Else
        Sigs = N
    End If
End Function