Sending Email Using CDO and MAPI

Sending emails via code used to be cool, but now it is a necessity. Below is code to send email via CDO. If the CDO call fails, it will send using MAPI. NOTE: You must have CDO for NT referenced in your project for this to work.

' Sends an email to the appropriate person(s)'' SendTo = List of email addresses separated by a semicolon.  Example:'                          [email protected]; [email protected]; [email protected]' Subject = Text that summarizes what the email is about' EmailText = Body of text that is the email' AttachmentPath = Directory in which the attachment resides' Attachment = File to send with the emailSub SendEmail(From As String, SendTo As String, Subject As String, _    EmailText As String, Optional AttachmentPath As String, _    Optional Attachment As String, Optional CC As String)    Const constRoutine As String = "SendEmail"    Dim strSendTo As String    Dim objSendMail As CDONTS.NewMail    Dim i As Integer    On Error GoTo TryMAPI        'Do not cause the user a major error, just log the error and keep going    If SendTo = "" Then Exit Sub    Set objSendMail = New CDONTS.NewMail    With objSendMail        On Error Resume Next        .From = From        If CC <> "" Then            .CC = CC        End If        On Error GoTo ErrorHandler        .To = SendTo        .Subject = Subject        .Body = EmailText        AttachmentPath = Trim$(AttachmentPath)                If AttachmentPath <> "" Then            If Right$(AttachmentPath, 1) <> "" Then                AttachmentPath = AttachmentPath & ""            End If            .AttachFile (AttachmentPath & Attachment)        End If        .Send    End With    GoTo ExitMeTryMAPI:    On Error GoTo ErrorHandler    'If CDO fails, try MAPI    If CC <> "" Then        strSendTo = SendTo & "; " & CC    Else        strSendTo = SendTo    End If    Call SendEmailMAPI(SendTo:=strSendTo, Subject:=Subject, _        EmailText:=EmailText)ExitMe:    Set objSendMail = Nothing    Exit SubErrorHandler:    Err.Raise Err.Number, Err.Source, Err.Description    Resume ExitMeEnd Sub' Sends an email to the appropriate person(s).' SendTo = List of email addresses separated by a semicolon.  Example:'                 [email protected]; [email protected]; [email protected]' Subject = Text that summarizes what the email is about' EmailText = Body of text that is the email' AttachmentPath = Directory in which the attachment resides' Attachment = File to send with the emailSub SendEmailMAPI(SendTo As String, Subject As String, EmailText As String, _    Optional AttachmentPath As String, Optional Attachment As String)   Const constRoutine As String = "SendEmailMAPI"   Dim intStart As Integer   Dim strSendTo As String   Dim intEnd As Integer   Dim i As Integer   On Error GoTo ErrorHandler      If frmEmailCommon.MAPISession.SessionID = 0 Then      frmEmailCommon.MAPISession.SignOn   End If   If SendTo = "" Then Exit Sub   With frmEmailCommon.MAPIMessages      .SessionID = frmEmailCommon.MAPISession.SessionID      .Compose      'Make sure that the SendTo always has a trailing semi-colon (makes it       ' easier below)      'Strip out any spaces between names for consistency      For i = 1 To Len(SendTo)         If Mid$(SendTo, i, 1) <> " " Then            strSendTo = strSendTo & Mid$(SendTo, i, 1)         End If      Next i      SendTo = strSendTo      If Right$(SendTo, 1) <> ";" Then         SendTo = SendTo & ";"      End If      'Format each recipient, each are separated by a semi-colon, like this:      '  [email protected];[email protected]; [email protected];      intEnd = InStr(1, SendTo, ";")      .RecipAddress = Mid$(SendTo, 1, intEnd - 1)      .ResolveName      intStart = intEnd + 1      Do         intEnd = InStr(intStart, SendTo, ";")         If intEnd = 0 Then            Exit Do         Else            .RecipIndex = .RecipIndex + 1            .RecipAddress = Mid$(SendTo, intStart, intEnd - intStart)            .ResolveName         End If         intStart = intEnd + 1      Loop      .MsgSubject = Subject      .MsgNoteText = EmailText      If Left$(Attachment, 1) = "" Then         Attachment = Mid$(Attachment, 2, Len(Attachment))      End If      If Attachment <> "" Then         If Right$(AttachmentPath, 1) = "" Then            .AttachmentPathName = AttachmentPath & Attachment         Else            .AttachmentPathName = AttachmentPath & "" & Attachment         End If        .AttachmentName = Attachment      End If      .Send False   End WithExitMe:   Exit SubErrorHandler:   Err.Raise Err.Number, m_constPgm & constRoutine, Err.Description   Resume ExitMeEnd Sub


This tip has been brought to you by Pragmatic Software Co. Inc, the creators of Defect Tracker, the tool of choice for tracking functional specifications, test cases and software bugs. Learn more at http://www.DefectTracker.com. Affiliate program also available at http://www.PragmaticSW.com/AffiliateSignup.

Share the Post:
Share on facebook
Share on twitter
Share on linkedin

Overview

The Latest

microsoft careers

Top Careers at Microsoft

Microsoft has gained its position as one of the top companies in the world, and Microsoft careers are flourishing. This multinational company is efficiently developing popular software and computers with other consumer electronics. It is a dream come true for so many people to acquire a high paid, high-prestige job

your company's audio

4 Areas of Your Company Where Your Audio Really Matters

Your company probably relies on audio more than you realize. Whether you’re creating a spoken text message to a colleague or giving a speech, you want your audio to shine. Otherwise, you could cause avoidable friction points and potentially hurt your brand reputation. For example, let’s say you create a

chrome os developer mode

How to Turn on Chrome OS Developer Mode

Google’s Chrome OS is a popular operating system that is widely used on Chromebooks and other devices. While it is designed to be simple and user-friendly, there are times when users may want to access additional features and functionality. One way to do this is by turning on Chrome OS