Sending Email Using CDO and MAPI

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:
XDR solutions

The Benefits of Using XDR Solutions

Cybercriminals constantly adapt their strategies, developing newer, more powerful, and intelligent ways to attack your network. Since security professionals must innovate as well, more conventional endpoint detection solutions have evolved

AI is revolutionizing fraud detection

How AI is Revolutionizing Fraud Detection

Artificial intelligence – commonly known as AI – means a form of technology with multiple uses. As a result, it has become extremely valuable to a number of businesses across

AI innovation

Companies Leading AI Innovation in 2023

Artificial intelligence (AI) has been transforming industries and revolutionizing business operations. AI’s potential to enhance efficiency and productivity has become crucial to many businesses. As we move into 2023, several

data fivetran pricing

Fivetran Pricing Explained

One of the biggest trends of the 21st century is the massive surge in analytics. Analytics is the process of utilizing data to drive future decision-making. With so much of

kubernetes logging

Kubernetes Logging: What You Need to Know

Kubernetes from Google is one of the most popular open-source and free container management solutions made to make managing and deploying applications easier. It has a solid architecture that makes

ransomware cyber attack

Why Is Ransomware Such a Major Threat?

One of the most significant cyber threats faced by modern organizations is a ransomware attack. Ransomware attacks have grown in both sophistication and frequency over the past few years, forcing

data dictionary

Tools You Need to Make a Data Dictionary

Data dictionaries are crucial for organizations of all sizes that deal with large amounts of data. they are centralized repositories of all the data in organizations, including metadata such as