Sending HTML message from MS Access using MAPI

[Francisco]

Hello there,

How can I send a HTML message from MS Access using CDO.MAPI. I know I can
accomplish this by using the Outlook library. However, I want to bypass the
Outlook security, I accomplish that by using MAPI, but now I cannot send a
HTML format message. Here is my code. Thank you.

Private Sub SendEmail(strEmailAdd As String, strFrom As String, strMessage
As String, _
strSubject As String, strCc As Variant, strBcc As
Variant)
On Error GoTo errHandler

Dim oSession As MAPI.Session
Dim MsgNew As MAPI.Message 'uses early binding
Dim Recip As MAPI.Recipient
Dim RecipCC As MAPI.Recipient
Dim RecipBCC As MAPI.Recipient
Dim AddEntries As MAPI.AddressEntries
Dim OnBehalfSender As MAPI.AddressEntry
Dim aCc() As String
Dim aBcc() As String
Dim strNTUser As String
Dim i As Integer


Set oSession = CreateObject("mapi.session")
strNTUser = Environ("UserName")
oSession.Logon profileName:=strNTUser 'use existing session

'create new message
Set MsgNew = oSession.Outbox.Messages.Add


'set on behalf sender
Set AddEntries = oSession.AddressLists(1).AddressEntries
AddEntries.Filter = Nothing 'reset
'TODO: Change on behalf user name
AddEntries.Filter.Name = strFrom
Set OnBehalfSender = AddEntries.GetFirst
Set MsgNew.Sender = OnBehalfSender 'set on behalf address
Set MsgNew.Sender = oSession.CurrentUser 'optional, the actual sender


'set message recipient
'TODO: Change recipient name
Set Recip = MsgNew.Recipients.Add(strEmailAdd, , 1)
Recip.Resolve


'set message recipient
'TODO: Change recipient name
aCc = Split(strCc, ";")
For i = 0 To UBound(aCc)
Set RecipCC = MsgNew.Recipients.Add(aCc(i), , 2)
RecipCC.Resolve
Next i


'set message recipient
'TODO: Change recipient name
aBcc = Split(strBcc, ";")
For i = 0 To UBound(aBcc)
Set RecipBCC = MsgNew.Recipients.Add(aBcc(i), , 3)
RecipBCC.Resolve
Next i

'set other message properties and send
With MsgNew
.Text = strMessage
.Subject = strSubject
.Update 'optional, leaves unsent mail in Outbox if Send fails
.Send
End With

'release objects
Set MsgNew = Nothing
Set OnBehalfSender = Nothing
Set Recip = Nothing
Set RecipCC = Nothing
Set RecipBCC = Nothing
Set AddEntries = Nothing
oSession.Logoff
Set oSession = Nothing

ExitHere:
'Set objOutlook = Nothing
Exit Sub

errHandler:
Select Case Err
Case Else
MsgBox "Error Number: " & Err.Number & vbNewLine & "Description:
" & Err.Description, vbCritical, "Error"

GoTo ExitHere
End Select
End Sub

 

[DCPan]

My Outlook is defaulted to sending by HTML, and the below worked fine without
any error messages

'Declare variables for Outlook Task
Dim objMailItem As Outlook.MailItem
Dim olkApp As Outlook.Application
Dim olkNameSpace As Namespace

'Set Outlook Task
Set olkApp = New Outlook.Application
Set olkNameSpace = olkApp.GetNamespace("MAPI")
Set objMailItem = olkApp.CreateItem(olMailItem)

'Display Outlook Message
With objMailItem
.To = strRecipient
.Attachments.Add strAttach
.Subject = strSubject
.Body = strBody
.ReadReceiptRequested = False
.Display
End With

'Clean Up
Set objMailItem = Nothing
Set olkNameSpace = Nothing
Set olkApp = Nothing

 

[Francisco]

Unfortunately, this might not work since I have many users with different
mail format. Is there a way I can control how my email is sent? Thank you.