Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How do I replace CDO 1.2.1 with Outlook Object Model (migrating from Office 2003 to Office 2007/2010 )

Replacing CDO 1.2.1 with OOM

How do I replace CDO 1.2.1 with Outlook Object Model (migrating from Office 2003 to Office 2007/2010 )

by 1DMF Posted Jan 28, 2011 (Edited Aug 9, 2012)

Well, if like me you've bashed your head on that brick wall that is Microsoft and their latest versions of Office, hopefully you will not have to bash your head for much longer....

Firstly, I have created an email wrapper class using CDO 1.2.1 , so you can see how I send emails with MS Access 2003 & Outlook 2003...

Please note, the wrapper class is very basic, no defensive programing or error checking has been implemented, so if you want to beef it up and make it more fault tolerant, be my guest!

EmailWrapper.cls -> CDO 1.2.1 (Office 2003)

Code:

Option Compare Database

' instance attribute email components
Private sSubject As String
Private cRecip As New Collection
Private cBCC As New Collection
Private sBody As String
Private cFiles As New Collection
Private cItems As New Collection
Private cItemTypes As New Collection
Private bDispEmail As Boolean
Private Sub Class_Initialize()
    Disp = False
End Sub
' Get Display Email Property
Public Property Get DispEmail() As Boolean
    DispEmail = bDispEmail
End Property

' Set Display Email Property
Public Property Let DispEmail(aValue As Boolean)
    bDispEmail = aValue
End Property
' Get Subject Property
Public Property Get Subject() As String
    Subject = sSubject
End Property

' Set Subject Property
Public Property Let Subject(aValue As String)
    sSubject = aValue
End Property
' Get Body Property
Public Property Get Body() As String
    Body = sBody
End Property

' Set Body Property
Public Property Let Body(aValue As String)
    sBody = aValue
End Property

' Get Recipients collection
Private Property Get Recip() As Collection
    Set Recip = cRecip
End Property

' Get BCC collection
Private Property Get BCC() As Collection
    Set BCC = cBCC
End Property

' Get file attachmets collection
Private Property Get Files() As Collection
    Set Files = cFiles
End Property

' Get image attachmets collection
Private Property Get Items() As Collection
    Set Items = cItems
End Property
' Get image attachments types collection
Private Property Get ItemTypes() As Collection
    Set ItemTypes = cItemTypes
End Property

' Add To recipient to collection
Public Sub addRecip(Rep As String)
    cRecip.Add (Rep)
End Sub

' Add BCC recipient to collection
Public Sub addBCC(Rep As String)
    cBCC.Add (Rep)
End Sub

' Add File to collection
Public Sub addFile(file As String)
    cFiles.Add (file)
End Sub

' Add item and type to collections
Public Sub addItem(i As String, t As String)
    cItems.Add (i)
    cItemTypes.Add (t)
End Sub


' Send email
Public Sub Send()
    
    On Error GoTo Email_Error
    
    Dim oApp As Outlook.Application
    Dim l_Msg As MailItem
    Dim colAttach As Outlook.Attachments
    Dim l_Attach As Outlook.Attachment
    Dim strEntryID As String
    Dim x As Integer
    
    ' CDO objects
    Dim oSession As MAPI.Session
    Dim oMsg As MAPI.Message
    Dim oAttachs As MAPI.Attachments
    Dim oAttach As MAPI.Attachment
    Dim colFields As MAPI.Fields
    Dim oField As MAPI.Field
    Dim oReceipt As Outlook.Recipient
    
    ' create new Outlook MailItem
    Set oApp = CreateObject("Outlook.Application")
    Set l_Msg = oApp.CreateItem(olMailItem)
       
    With l_Msg

        'add recipients
        For Each eml In Recip
            Set oReceipt = .Recipients.Add(eml)
            oReceipt.Type = olTo
        Next

        'add BCC recipients
        For Each eml In BCC
            Set oReceipt = .Recipients.Add(eml)
            oReceipt.Type = olBCC
        Next

        'set email subject
        .Subject = Subject
        
        'set body  HTML
        .HTMLBody = Body
        
    End With
    
    'clear recipients
    Set oReceipt = Nothing
        
    'check items for mime encoding
    If Items.Count > 0 Then

        ' attach items
        Set colAttach = l_Msg.Attachments
        For x = 1 To Items.Count
            Set l_Attach = colAttach.Add(Items.Item(x))
        Next
        
        ' clear attachments
        Set colAttach = Nothing
        Set l_Attach = Nothing
    
        ' close and save mail item
        l_Msg.Close olSave
    
        ' get MSG ID
        strEntryID = l_Msg.EntryID
       
        ' clear mail item
        Set l_Msg = Nothing
                  
        ' initialize CDO session
        Set oSession = CreateObject("MAPI.Session")
        oSession.Logon "", "", True, False
  
        ' get the message created earlier
        Set oMsg = oSession.GetMessage(strEntryID)
    
        ' Set attachments
        Set oAttachs = oMsg.Attachments

        ' loop and set items as mime attachments
        For x = 1 To Items.Count
            Set oAttach = oAttachs.Item(x)
            Set colFields = oAttach.Fields
            Set oField = colFields.Add(CdoPR_ATTACH_MIME_TAG, ItemTypes.Item(x))
            Set oField = colFields.Add(&H3712001E, "item" & x)
            oMsg.Fields.Add "{0820060000000000C000000000000046}0x8514", 11, True
            oMsg.Update
        Next x
        
        ' clean up CDO objects
        Set oField = Nothing
        Set colFields = Nothing
        Set oMsg = Nothing
        oSession.Logoff
        Set oSession = Nothing
        Set oAttach = Nothing
        Set oAttachs = Nothing
        
        ' get the Outlook MailItem again
        Set l_Msg = oApp.GetNamespace("MAPI").GetItemFromID(strEntryID)
    
    End If

    ' add normal file attachments
    For Each att In Files
        l_Msg.Attachments.Add (att)
    Next

    ' save email
    l_Msg.Save

    ' check if display or send
    If DispEmail Then
        l_Msg.Display
    Else
        l_Msg.Send
    End If

    ' clean up email object
    Set l_Msg = Nothing
    Set oAttach = Nothing
    Set oApp = Nothing
    
    Exit Sub
    
Email_Error:
    MsgBox err.Description, vbOKOnly + vbCritical, "Error: " & err.Number
End Sub

To then use the EmailWrapper class you need to create a new Class in Access called 'EmailWrapper' and paste that code into it (I have included a zip file at the end of the FAQ with the class if you prefer)

Then in your application you can then create and send emails like so...

Code:

' Declare and initialise EmailWrapper Object
Dim anEmail As New EmailWrapper

' Add inline MIME attachments
anEmail.addItem "c:\MyDirectory\CSS\myCSS.css", "text/css"
anEmail.addItem "c:\MyDirectory\Images\Logo.gif", "image/gif"

' Add Subject
anEmail.Subject = "This is my email subject"

' Add HTML Body
anEmail.Body = "<html><head><title>This is the HTML page title.</title>" & _
    "<link href=""cid:item1"" rel=""stylesheet"" type=""text/css"" />" & _
    "</head><body><img id=""logo"" src=""cid:item2"" title=""This is my Logo"" alt=""This is the alternative text"" />" & _
    "<p>This is just some paragraph text</p></body></html>"

' Add standard attachments
anEmail.addFile "c:\MyDirectory\Docs\myWordDoc.doc"

' Add Recipients
anEmail.addRecip "fred@mydomain.com"
anEmail.addRecip "bob@mydomain.com"

' Add BCC recipients
anEmail.addBCC "boss@mydomain.com"
anEmail.addBCC "accounts@mydomain.com"

' Send Email
anEmail.Send

' Clear object
Set anEmail = Nothing

It's that simple! Note that each inline MIME attachment is given a unique CID of 'item1,item2,item3' etc. in the order you add them to the æanEmailÆ EmailWrapper object, so you either need to make sure your HTML correctly refers to them as src="cid:item1" , src="cid:item2" etc..

OR

If you have a HTML file you want to merge into the email wrapper you could do something like this...

Code:

    ' Add inline MIME attachments
    anEmail.addItem "c:\MyDirectory\Images\header.gif", "image/gif"
    anEmail.addItem "c:\MyDirectory\Images\side.gif", "image/gif"
    anEmail.addItem "c:\MyDirectory\Images\people.gif", "image/gif"

    ' get HTML template
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile("C:\MyDirectory\eNews\myFile.html, 1)
    
    sHTML = f.readall
    
    ' replace holders for images
    sHTML = Replace(sHTML, "header.gif", "cid:item1")
    sHTML = Replace(sHTML, "side.gif", "cid:item2")
    sHTML = Replace(sHTML, "people.gif", "cid:item3")

    anEmail.Body = sHTML

As you can see it's quite flexible in the way you can create your HTML email body and correctly reference the MIME encoded inline attachments.

.... Right now you have a basic overview of using the wrapper via CDO 1.2.1, you're probably wanting to know how to make it work with newer versions of MS Office.... so here is the new EmailWrapper class to work with OOM...

EmailWrapper.cls -> OOM (Office 2007+)

Code:

Option Explicit

' instance attribute email components
Private sSubject As String
Private cRecip As New Collection
Private cBCC As New Collection
Private sBody As String
Private cFiles As New Collection
Private cItems As New Collection
Private cItemTypes As New Collection
Private bDispEmail As Boolean
Private sSender As String
Const olMailItem As Integer = 0
Const olTo As Integer = 1
Const olCC As Integer = 2
Const olBCC As Integer = 3
' constructor
Private Sub Class_Initialize()
    bDispEmail = False
End Sub
' Get Display Email Property
Public Property Get DispEmail() As Boolean
    DispEmail = bDispEmail
End Property

' Set Display Email Property
Public Property Let DispEmail(aValue As Boolean)
    bDispEmail = aValue
End Property
' Get Subject Property
Public Property Get Subject() As String
    Subject = sSubject
End Property

' Set Subject Property
Public Property Let Subject(aValue As String)
    sSubject = aValue
End Property
' Get Body Property
Public Property Get Body() As String
    Body = sBody
End Property

' Set Body Property
Public Property Let Body(aValue As String)
    sBody = aValue
End Property

' Get Recipients collection
Private Property Get Recip() As Collection
    Set Recip = cRecip
End Property

' Get BCC collection
Private Property Get BCC() As Collection
    Set BCC = cBCC
End Property

' Get file attachments collection
Private Property Get Files() As Collection
    Set Files = cFiles
End Property

' Get item attachments collection
Private Property Get Items() As Collection
    Set Items = cItems
End Property
' Get item attachmet types collection
Private Property Get ItemTypes() As Collection
    Set ItemTypes = cItemTypes
End Property

' Add To recipient to collection
Public Sub addRecip(Rep As String)
    cRecip.Add (Rep)
End Sub

' Add BCC recipient to collection
Public Sub addBCC(Rep As String)
    cBCC.Add (Rep)
End Sub

' Add File to collection
Public Sub addFile(file As String)
    cFiles.Add (file)
End Sub

' Add item and type to collections
Public Sub addItem(i As String, t As String)
    cItems.Add (i)
    cItemTypes.Add (t)
End Sub

' Get Sender Property
Public Property Get Sender() As String
    Sender = sSender
End Property

' Set Sender Property
Public Property Let Sender(aValue As String)
    sSender = aValue
End Property

' Send email
Public Sub Send()
    
    On Error GoTo Email_Error
    
    Dim oApp As Object
    Dim l_Msg As Object
    Dim colAttach As Object
    Dim l_Attach As Object
    Dim strEntryID As String
    Dim x As Integer
    Dim oReceipt As Object
    Dim oPA As Object
    Dim eml As Variant
    Dim att As Variant
       
    Const PR_ATTACH_MIME_TAG = "http://schemas.microsoft.com/mapi/proptag/0x370E001E"
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
    
    ' create new Outlook MailItem
    Set oApp = CreateObject("Outlook.Application")
    Set l_Msg = oApp.CreateItem(olMailItem)
       
    With l_Msg
    
        'add recipients
        For Each eml In Recip
            Set oReceipt = .Recipients.Add(eml)
            oReceipt.Type = olTo
        Next

        'add BCC recipients
        For Each eml In BCC
            Set oReceipt = .Recipients.Add(eml)
            oReceipt.Type = olBCC
        Next

        'set email subject
        .Subject = Subject
        
        'set body  HTML
        .HTMLBody = Body
        
        ' check for sender address
        If Nz(Sender, "") <> "" Then
            .SentOnBehalfOfName = Sender
        End If
        
    End With
    
    'clear recipients
    Set oReceipt = Nothing
        
    'check items for mime encoding
    If Items.Count > 0 Then
        
        ' attach items
        Set colAttach = l_Msg.Attachments
        For x = 1 To Items.Count
            Set l_Attach = colAttach.Add(Items.Item(x))
            Set oPA = l_Attach.PropertyAccessor
            oPA.SetProperty PR_ATTACH_MIME_TAG, ItemTypes.Item(x)
            oPA.SetProperty PR_ATTACH_CONTENT_ID, "item" & x
            oPA.SetProperty PR_ATTACHMENT_HIDDEN, True
        Next
                   
    End If
    
    l_Msg.Save
        
    ' add normal file attachments
    For Each att In Files
        l_Msg.Attachments.Add (att)
    Next
        
    ' save email
    l_Msg.Save
    
    ' check if display or send
    If DispEmail Then
        l_Msg.Display
    Else
        l_Msg.Send
    End If

Exit_Email:
    ' clean up email object
    Set l_Msg = Nothing
    Set l_Attach = Nothing
    Set oApp = Nothing
    Set oPA = Nothing
    
    Exit Sub
    
Email_Error:
    MsgBox Err.Description, vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume Exit_Email
    
End Sub

As you can see not much has changed, apart from the CDO/MAPI code and three new constants need to be declared to reference the correct MAPI namespace properties.

So there you have it, simple but effective email wrapper class that works with both CDO 1.2.1 (Collaboration Data Objects) or OOM (Outlook Object Model).

Oh, there is one other property of the EmailWrapper class that can be set, DispEmail, it is 'False' by default, but if you set it to 'True' prior to calling the Send method...

Code:

    anEmail.DispEmail = True

Instead of the email being sent, it is displayed on screen from your 'Drafts' email folder!

Hope you find the wrapper class helpful and happy emailing

Note: This does not stop the Outlook Security Guard message from appearing, so if you send bulk emails, you will need to look at getting a program called 'Express click Yes', alternatively write your own wrapper which doesn't trigger the Outlook Security Guard and share it with us ;-) Or create a trusted location reg_key.

It is worth noting that if you roll out your application via Solution Packager, remember to include a trusted location reg_key to eliminate that pesky Outlook Security Guard!

I have found that Trusted Location reg_keys can be flakey on Office 2003!

Also remember Office 2007 onwards uses Word for Outlook email rendering and so sucks when it comes to standards compliant HTML/CSS coded emails, make sure you write your email HTML in a way that will render correctly.

For more info on the sucky Outlook issues with MSO2007 onwards check out this link http://msdn.microsoft.com/en-us/library/aa338201(v=office.12).aspx

To download a zip file with both versions of the EmailWrapper class [link http://www.homeloanpartnership.com/EmailWrapper.zip]Click Here[/link]

UPDATE 23.02.2012 ->

I have amended the OOM wrapper to work with all recent versions of MS Office (2003/2007/2010) by using late bindings.

This way you can roll it out in your application and not worry about a mixed MS Office environment.

UPDATE 20.06.2012 ->

I had noticed that I wasn't using 'Option Explicit' , so have amended the code to use this strict pragma and ensured all constants and variables have been declared.

also I have added another attribute 'Sender' , so if you have the requirment for your application to send from a different mailbox other than the user logged on, simply provide the 'Sender' attribute as follows

Code:

    anEmail.Sender = "another@mydomain.com"

Remember that the user must have at least 'send on behalf of' permissions for the mailbox they are trying to impersonate.

If you do not want the actual sender to appear what so ever on the email and ensure all replies come back to the email address being impersonated, you need to ensure the user also has 'Send As' permissions on the mailbox.

If you need help with these permissions simply speak to who ever is in charge / administers your exchange server

Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.

Accept Learn more…

Back

Top