Modules: Send Email using CDO/Outlook 98

With the new CDO reference library available with Outlook 98,   you can send emails through Automation from any Access 97 database..

Here's a class module which automates this for you.  Set a reference under Tools/References to Microsoft CDO 1.21 and paste the code in a new Class Module.

  Download MAPIStuff.Zip (50,488 bytes).  Access 97 version.

'**************** Usage Example Start ****************
Sub TestMAPIEmail()
Dim clMAPI As clsMAPI
    Set clMAPI = New clsMAPIEmail
    With clMAPI
        .MAPILogon
        .MAPIAddMessage
        .MAPISetMessageBody = "Test Message"
        .MAPISetMessageSubject = "Some Test"
        .MAPIAddRecipient stPerson:="dash10@hotmail.com", _
                                    intAddressType:=1         'To
        .MAPIAddRecipient stPerson:="Dev Ashish", _
                                    intAddressType:=2         'cc
        .MAPIAddRecipient stPerson:="smtp:dash10@hotmail.com", _
                                    intAddressType:=3         'bcc

        .MAPIAddAttachment "C:\temp\Readme.doc", "Jet Readme"
        .MAPIAddAttachment stFile:="C:\config.sys"

        .MAPIUpdateMessage
        .MAPISendMessage boolSaveCopy:=False
        .MAPILogoff
    End With
End Sub
'**************** Usage Example End ****************

'**************** Class Start ***********************
'This code was originally written by Dev Ashish
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Option Compare Database
Option Explicit

Private mobjSession As MAPI.Session
Private mobjMessage As Message
Private mboolErr As Boolean
Private mstStatus As String
Private mobjNewMessage As Message

Private Const mcERR_DOH = vbObjectError + 10000
Private Const mcERR_DECIMAL = 261144    'low word order +1000

Public Sub MAPIAddMessage()
    With mobjSession
        Set mobjNewMessage = .Outbox.Messages.Add
    End With
End Sub

Public Sub MAPIUpdateMessage()
    mobjNewMessage.Update
End Sub

Private Sub Class_Initialize()
    mboolErr = False
End Sub

Private Sub Class_Terminate()
    On Error Resume Next
    Set mobjMessage = Nothing
    mobjSession.Logoff
    Set mobjSession = Nothing
End Sub

Public Property Let MAPISetMessageBody(stBodyText As String)
    If Len(stBodyText) > 0 Then mobjNewMessage.Text = stBodyText
End Property

Public Property Let MAPISetMessageSubject(stSubject As String)
    If Len(stSubject) > 0 Then mobjNewMessage.Subject = stSubject
End Property

Public Property Get MAPIIsError() As Boolean
    MAPIIsError = mboolErr
End Property

Public Property Get MAPIRecipientCount() As Integer
    MAPIRecipientCount = mobjNewMessage.Recipients.Count
End Property

Public Sub MAPIAddAttachment(stFile As String, _
                        Optional stLabel As Variant)
Dim objAttachment As Attachment
Dim stMsg As String

    On Error GoTo Error_MAPIAddAttachment

    If mboolErr Then Err.Raise mcERR_DOH
    If Len(Dir(stFile)) = 0 Then Err.Raise mcERR_DOH + 10

    mstStatus = SysCmd(acSysCmdSetStatus, "Adding Attachments...")

    If IsMissing(stLabel) Then stLabel = CStr(stFile)

    With mobjNewMessage
        .Text = " " & mobjNewMessage.Text
        Set objAttachment = .Attachments.Add
        With objAttachment
            .Position = 0
            .Name = stLabel
            'no need to link a file me thinks
            .Type = CdoFileData
            .ReadFromFile stFile
        End With
        .Update
    End With

Exit_MAPIAddAttachment:
    Set objAttachment = Nothing
    Exit Sub
Error_MAPIAddAttachment:
    mboolErr = True
    If Err = mcERR_DOH + 10 Then
        stMsg = "Couldn't locate the file " & vbCrLf
        stMsg = stMsg & "'" & stFile & "'." & vbCrLf
        stMsg = stMsg & "Please check the file name and path and try again."
        MsgBox stMsg, vbExclamation + vbOKOnly, "File Not Found"
    ElseIf Err <> mcERR_DOH Then
        MsgBox "Error " & Err.Number & vbCrLf & Err.Description
    End If
    Resume Exit_MAPIAddAttachment
End Sub

Public Sub MAPIAddRecipient(stPerson As String, intAddressType As Integer)
Dim objNewRecipient As Recipient 'local

    On Error GoTo Error_MAPIAddRecipient
    mstStatus = SysCmd(acSysCmdSetStatus, "Adding Recipients...")

    If mboolErr Then Err.Raise mcERR_DOH

    'If there's no SMTP present in the stPerson var, then
    'we have to use Name, else Address
    With mobjNewMessage
        If InStr(1, stPerson, "SMTP:") > 0 Then
            Set objNewRecipient = .Recipients.Add(Address:=stPerson, _
                                                Type:=intAddressType)
        Else
            Set objNewRecipient = .Recipients.Add(Name:=stPerson, _
                                                Type:=intAddressType)
        End If
        objNewRecipient.Resolve
    End With

Exit_MAPIAddRecipient:
    Set objNewRecipient = Nothing
    Exit Sub

Error_MAPIAddRecipient:
    mboolErr = True
    Resume Exit_MAPIAddRecipient
End Sub

Public Sub MAPISendMessage(Optional boolSaveCopy As Variant, _
                            Optional boolShowDialog As Variant)

    mstStatus = SysCmd(acSysCmdSetStatus, "Sending message...")
    If IsMissing(boolSaveCopy) Then
        boolSaveCopy = True
    End If
    If IsMissing(boolShowDialog) Then
        boolShowDialog = False
    End If

    mobjNewMessage.Send savecopy:=boolSaveCopy, showdialog:=boolShowDialog
End Sub

Public Sub MAPILogon()
On Error GoTo err_sMAPILogon
Const cERROR_USERCANCEL = -2147221229

    mstStatus = SysCmd(acSysCmdSetStatus, "Login....")
    Set mobjSession = CreateObject("MAPI.Session")
    mobjSession.Logon

exit_sMAPILogon:
    Exit Sub

err_sMAPILogon:
    mboolErr = True
    If Err = CdoE_LOGON_FAILED - mcERR_DECIMAL Then
        MsgBox "Logon Failed", vbCritical + vbOKOnly, "Error"
    ElseIf Err = cERROR_USERCANCEL Then
        MsgBox "Aborting since you pressed cancel.", _
                vbOKOnly + vbInformation, "Operatoin Cancelled!"
    Else
        MsgBox "Error number " & Err - mcERR_DECIMAL & " description. " _
                & Error$(Err)
    End If
    Resume exit_sMAPILogon
End Sub

Public Sub MAPILogoff()
On Error GoTo err_sMAPILogoff
    mstStatus = SysCmd(acSysCmdSetStatus, "Logging off...")
    mobjSession.Logoff

    Set mobjNewMessage = Nothing
    Set mobjSession = Nothing
    mstStatus = SysCmd(acSysCmdClearStatus)
exit_sMAPILogoff:
    Exit Sub

err_sMAPILogoff:
    Resume exit_sMAPILogoff
End Sub
'**************** Class End  ***********************