What's New
Q & A
Tip Jar
C# Helper...
Follow VBHelper on Twitter
MSDN Visual Basic Community
TitleUse MAPI to send email to a list of students with VBA in Excel
DescriptionThis example shows how to use MAPI to send email to a list of students with VBA in Excel.
KeywordsMAPI, mail, email, sendmail, students, Excel, VBA
CategoriesOffice, API
When you click the worksheet's Email All button, the code calls subroutine EmailToAll. That routine finds the columns holding the students' names and email addresses, and the header row. It loops through the rows adding names and email addresses to the names and emails collections.

Next the program displays the form frmSendToAll to let the user enter the message. If the user clicks Send, the code calls subroutine SendEmail, passing it the message's subject, body, To address and name, Cc address and name, and Bcc addresses and names.

' Send email to all students.
Public Sub SendEmailToAll()
Dim sheet As Worksheet
Dim header_row As Integer
Dim name_col As Integer
Dim full_name As String
Dim first_name As String
Dim last_name As String
Dim r As Integer
Dim emails As New Collection
Dim names As New Collection
Dim email_col As Integer
Dim body As String
Dim subject As String

    Set sheet = ActiveSheet
    name_col = _
    email_col = _
    header_row = _
    r = header_row + 2
        ' Get the student's name.
        full_name = sheet.Cells(r, name_col)
        first_name = Mid$(full_name, InStr(full_name, ", ") _
            + 2)
        last_name = Left$(full_name, InStr(full_name, ", ") _
            - 1)
        full_name = first_name & " " & last_name
        names.Add full_name

        ' Add this student's email address.
        emails.Add sheet.Cells(r, email_col)

        ' Get the next student.
        r = r + 1
        If sheet.Cells(r, name_col) = "" Then Exit Do

    subject = "Notice to all students"
    body = _
        "(Enter the message here.)" & vbCrLf & vbCrLf & _
        "Thanks," & vbCrLf & vbCrLf & _

    ' Let the user check the email.
    frmSendToAll.txtTo.Text = "<All>"
    frmSendToAll.txtSubject.Text = subject
    frmSendToAll.txtBody.Text = body
    frmSendToAll.Show vbModal

    ' See which button the user clicked.
    If frmSendToAll.Result = "Cancel" Then Exit Sub

    ' Get any changes to the subject or body.
    subject = frmSendToAll.txtSubject.Text
    body = frmSendToAll.txtBody.Text

    ' Send the email.
    SendEmail _
        "Rod Stephens", "mstephens3@msn.com", _
        "Rod Stephens", "mstephens3@msn.com", _
        names, emails, _
        subject, body
End Sub
Subroutine SendEmail displays the message's values in the Debug window. It then opens a MAPI session.

It creates a new MAPIMessages object and calls its Compose method. It sets the recipient index RecipIndex to 0 and enters information for the To recipient. It then sets RecipIndex to 1 and enters information about the Cc recipient. The program then enters a loop and repeats those steps to enter information for all of the students as Bcc recipients.

The code then sets the message's subject and body, and sends the message.

' Send an email message to all students.
Public Sub SendEmail(ByVal to_name As String, ByVal _
    to_address As String, ByVal cc_name As String, ByVal _
    cc_address As String, ByVal bcc_names As Collection, _
    ByVal bcc_addresses As Collection, ByVal subject As _
    String, ByVal body As String)
Dim mapi_session As MSMAPI.MAPISession
Dim mapi_messages As MSMAPI.MAPIMessages
Dim i As Integer

    Debug.Print "To: " & to_name & " <" & to_address & ">"
    Debug.Print "Cc: " & cc_name & " <" & cc_address & ">"
    If Not (bcc_names Is Nothing) Then
        For i = 1 To bcc_names.Count
            Debug.Print "Bcc: " & bcc_names(i) & " <" & _
                bcc_addresses(i) & ">"
        Next i
    End If
    Debug.Print "Subject: " & subject
    Debug.Print "Body: " & vbCrLf & body
    Debug.Print _

    On Error GoTo MailError

    Set mapi_session = New MSMAPI.MAPISession
    With mapi_session
        .LogonUI = False
        ' Fill in username and password if necessary.
        '.username = "username"
        '.password = "password"
    End With

    Set mapi_messages = New MSMAPI.MAPIMessages
    With mapi_messages
        .SessionID = mapi_session.SessionID

        .RecipIndex = 0
        .RecipDisplayName = to_name
        .RecipAddress = to_address
        .RecipType = mapToList

        .RecipIndex = 1
        .RecipDisplayName = cc_name
        .RecipAddress = cc_address
        .RecipType = mapCcList

        If Not (bcc_names Is Nothing) Then
            For i = 1 To bcc_names.Count
                .RecipIndex = i + 1
                .RecipDisplayName = bcc_names(i)
                .RecipAddress = bcc_addresses(i)
                .RecipType = mapBccList
            Next i
        End If

        .AddressResolveUI = False
        .MsgSubject = subject
        .MsgNoteText = body
        .Send False
    End With

    Exit Sub

    MsgBox err.Description
    Exit Sub
End Sub
Copyright © 1997-2006 Rocky Mountain Computer Consulting, Inc.   All rights reserved.