Solved

How to resolve Mapi.Message not supporting HTMLBody from MS Access

Posted on 2008-10-15
4
1,050 Views
Last Modified: 2013-11-28
Hello experts,

I am trying to use Mapi to send email from MS Access.  I know there other ways to achieve this which would resolve my problem of dealing HTML.  However, there is a con so here is the dilema.  I need to use Mapi because it is the only way I found it gets around the profile resolution with outlook.  Everything works fine except for the HTML format.  How can this be resolved?  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

      .Text.HTMLBody = 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:

    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

Open in new window

0
Comment
Question by:fcoit
  • 2
  • 2
4 Comments
 
LVL 16

Expert Comment

by:Chuck Wood
ID: 22723997
I had to use .Display in Outlook before adding the body to get the HTML to work. Perhaps there is something similar in MAPI?

-Chuck
0
 

Author Comment

by:fcoit
ID: 22724298
cwood-wm-com,

I found this but I do not know how to incorporate this into my code.

oMailItem.BodyFormat = OlBodyFormat.olFormatHTML

Thank you for your input.

As far as the Display method is not available.
0
 
LVL 16

Accepted Solution

by:
Chuck Wood earned 500 total points
ID: 22724637
In Outlook 12.0 (2007) there is a .BodyFormat property and the constant olFormatHTML is equal to 2, but I am not sure that will help you in MAPI. By the way, the .BodyFormat property is not available in Outlook 2000.

In case it might be useful, here is my code for a class I use with Outlook that does not seem to have a problem with profile resolution but Outlook must be open on the user's computer.

-Chuck
VERSION 1.0 CLASS

BEGIN

  MultiUse = -1  'True

END

Attribute VB_Name = "clsSendEmail"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = False

Attribute VB_Exposed = False

Option Explicit

'===================================================================

' version 1.0.2  6/12/2008

'===================================================================

'  requires:

'    reference(s) to:

'      Microsoft Outlook 9.0 or later

'===================================================================

Public Function Email(ByVal strTo As String, ByVal strSubject As String, _

  ByVal strBody As String, Optional ByVal strCC As String, Optional ByVal strAttachment As String, _

  Optional ByVal intImportance As Integer, Optional ByVal strVotingOptions As String, _

  Optional ByVal fDeliveryReq As Boolean, Optional ByVal fReadRecpt As Boolean) As Boolean

' Purpose: Email an Outlook mail item

    ' set the initial state of the function

    Email = False

    Dim outl As New Outlook.Application, intI As Integer

    ' create an email item

    Dim outMsg As Outlook.MailItem

    Set outMsg = outl.CreateItem(olMailItem)

    With outMsg

        ' display the message

        .Display

        ' set the message parts

        .To = strTo

        .Subject = strSubject

        .HTMLBody = strBody

        If Not IsNull(strCC) And Len(Trim(strCC)) > 0 Then .cc = strCC

        If Not IsNull(strAttachment) And Len(Trim(strAttachment)) > 0 Then .Attachments.Add strAttachment

        .OriginatorDeliveryReportRequested = fDeliveryReq

        .ReadReceiptRequested = fReadRecpt

        .VotingOptions = strVotingOptions

        ' importance: High=2, Normal=1, Low=0

        .Importance = intImportance

        ' send the message

        .Send

        ' set the final state of the function

        Email = True

    End With

End Function

Open in new window

0
 

Author Comment

by:fcoit
ID: 22724872
Thanks again.

I was hoping to stay away from Outlook.  The problem with Outlook is that if a session has not been started the user profile will not be resolved and that will not work.  So the user must open Outlook before running the code.  
0

Featured Post

Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
sort Time by AM and PM in query 2 18
ms/access hyperlink/ftp 7 35
Track name AutoCorrect info 14 46
Getting the Error "User-defined type not defined" in MS Access 2013 16 41
This article is a continuation or rather an extension from Cascading Combos (http://www.experts-exchange.com/A_5949.html) and builds on examples developed in detail there. It should be understandable alone, but I recommend reading the previous artic…
In the article entitled Working with Objects – Part 1 (http://www.experts-exchange.com/Microsoft/Development/MS_Access/A_4942-Working-with-Objects-Part-1.html), you learned the basics of working with objects, properties, methods, and events. In Work…
Familiarize people with the process of retrieving data from SQL Server using an Access pass-thru query. Microsoft Access is a very powerful client/server development tool. One of the ways that you can retrieve data from a SQL Server is by using a pa…
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now