Sub Email_Picture_With_Signature()
' ZVI:2017-07-29 sql.ru

  ' --> Settings, change to suit
  Const PicPathName = "C:\Temp\ThePictire.jpg"  ' Full pathname to the picture
  Const IsDisplay As Boolean = True             ' Change to False to .Send instead of .Display
  Const IsSilent As Boolean = False             ' Change to True to skip confirmation MsgBox
  '<-- End of settings
  
  Dim OutlApp As Object
  Dim Signature As String, Message As String, PicName As String
  Dim IsOutlCreated As Boolean
  
  PicName = Mid(PicPathName, InStrRev(PicPathName, "\") + 1)
  
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsOutlCreated = True
  End If
  On Error GoTo 0
  
  ' Prepare email with embedded pictire and the default signature
  With OutlApp.CreateItem(0)
    
    .BodyFormat = 2
    
    ' Add the attachment first for correct attachment's name with non English symbols
    .Attachments.Add PicPathName
   
    ' Get default email signature without blinking (instead of .Display method)
    With .GetInspector: End With
    Signature = .HTMLBody
 
    ' Prepare e-mail (uncommenmt and fill the lines below)
    .Subject = "Embedding a Picture"
    .To = "email@is.here"
    .CC = ""
    Message = "Hi," & vbLf & vbLf _
          & "Look at this picture please" & vbLf & vbLf _
          & Chr(60) & "IMG src=cid:" & PicName & Chr(62) & vbLf
    .HTMLBody = Replace(Message, vbLf, Chr(60) & "br" & Chr(62)) & Signature
   
    ' Try to send or just display the e-mail
    On Error Resume Next
    If IsDisplay Then .Display Else .Send
   
    ' Show error of .Send method
    If Not IsDisplay Then
      ' Put focus to the host application window
      Application.Visible = True
      ' Show the sending status
      If Err Then
        MsgBox "E-mail has not been sent for some reasons" & vbLf & "Please check it", vbExclamation
        .Display
      Else
        If Not IsSilent Then
          MsgBox "E-mail has been sent successfully", vbInformation
        End If
      End If
    End If
    On Error GoTo 0
 
  End With
 
  ' Try to quit Outlook if it was not previously open
  If IsOutlCreated Then OutlApp.Quit
 
  ' Try to release the memory of object variable
  Set OutlApp = Nothing
  
End Sub