| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667 |
- 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
|
