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 = _
        Application.names("NAME_COL").RefersToRange.Column
    email_col = _
        Application.names("EMAIL_COL").RefersToRange.Column
    header_row = _
        Application.names("HEADER_ROW").RefersToRange.Row
    r = header_row + 2
    Do
        ' 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
    Loop

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

    ' 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

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"
        .SignOn
    End With

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

        .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

    mapi_session.SignOff
    Exit Sub

MailError:
    MsgBox err.Description
    Exit Sub
End Sub