Option Compare Database
Option Explicit

' ** Access Toolbox Module **
' on 2017-02-28,
' @author: Olivier Massot
' V 1.0

' Send mails

' ! Requires Microsoft Outlook XX.X library

Public Sub send_mail(ByVal subject As String, _
                    ByVal content As String, _
                    Optional recipient As String, _
                    Optional auto_send As Boolean = False, _
                    Optional attachment As String = "", _
                    Optional signature As Boolean = False)

    Dim olApp As Outlook.Application
    Dim objMail As Outlook.MailItem
    Dim oAccount As Outlook.Account
    Dim olExplorer As Outlook.Explorer
    Set olApp = GetObject("", "Outlook.Application")
    Dim mpf As Outlook.MAPIFolder
    
    Dim is_html As Boolean
    is_html = (Left(content, 6) = "<html>")
    
    Set objMail = olApp.CreateItem(olMailItem)
    objMail.subject = subject
    
    If is_html = True Then
      If signature = True Then
        objMail.display
        objMail.HTMLBody = content & vbNewLine & objMail.HTMLBody
        If auto_send Then objMail.Close olDiscard
      Else
        objMail.HTMLBody = content
        If Not auto_send Then objMail.display
      End If
      objMail.BodyFormat = olFormatHTML
    Else
      objMail.Body = content
      objMail.BodyFormat = olFormatRichText
      If Not auto_send Then objMail.display
    End If
    
    If Len(attachment) > 0 Then
        objMail.Attachments.Add attachment, olByValue, 1
    End If
    
    objMail.To = recipient
    'objMail.Cc = ""
    'objMail.BCC= ""
     
    If auto_send Then objMail.send
    
    Set olApp = Nothing
    Set objMail = Nothing
End Sub

Public Function current_account()
 Dim olApp As Outlook.Application
 Set olApp = GetObject("", "Outlook.Application")
 current_account = olApp.Session.Accounts(1).SmtpAddress
End Function