Using Automation to Send a Microsoft Exchange Message

 '--------------------------------------------------------------------
    ' This procedure sets an object variable to the MAPI Session object
    ' using the CreateObject() function. Then, it logs on to the session
    ' using a predefined profile. As soon as you are logged on,
    ' the procedure creates
    ' a new message and adds it to the Messages collection of the Outbox
    ' of the user. Then, it creates two recipients (one on the TO: line and
    ' one on the CC: line) and then adds both to the Recipients collection
    ' of the message. Next, it resolves the names of all recipients.
    ' Then, it attaches a sample file before filling in the Subject,
    ' Text, and Importance attributes of the message.
    '--------------------------------------------------------------------
     Sub SendMAPIMessage()
        Dim MapiSession As Object
        Dim MapiMessage As Object
        Dim MapiRecipient As Object
        Dim MapiAttachment As Object
        Dim Recpt
        Dim errObj As Long
        Dim errMsg

        On Error GoTo MAPITrap
        ' Create the MAPI Session.
        Set MapiSession = CreateObject("Mapi.Session")

        ' Log on to the session. If the ProfileName argument is omitted,
        ' Microsoft Exchange prompts you for the profile to use. If the
        ' profile name is incorrect, you receive a runtime error.
         MapiSession.Logon profilename:="Steven Buchanan"

        ' Add a message to the Outbox.
        Set MapiMessage = MapiSession.Outbox.Messages.Add

        ' Add the recipients of the message. Note, each recipient must be
        ' added separately to the Recipients collection of the Message
        ' object.

        With MapiMessage
            Set MapiRecipient = MapiMessage.Recipients.Add
            MapiRecipient.Name = "Nancy Davolio"
            MapiRecipient.Type = mapiTo
            Set MapiRecipient = MapiMessage.Recipients.Add
            MapiRecipient.Name = "Andrew Fuller"
            MapiRecipient.Type = mapiCc
            Set MapiRecipient = MapiMessage.Recipients.Add
            MapiRecipient.Name = "Michael Suyama"
            MapiRecipient.Type = mapiBcc

            ' Resolve each recipient's e-mail name.
            ' Starting with Outlook version 8.03 (ref. Q172623) 
            ' OLE Messaging 1.0 was replaced with Active Messaging 1.1.
            ' Outlook 98 (version 8.5) replaced Active Messaging
            ' with Microsoft CDO (Collaborative Data Objects) 1.21.
            ' OLE Messaging 1.0 uses a zero-based Recipients collection;
            ' Active Messaging 1.1 and Microsoft CDO 1.21 are 1-based.
            For Recpt = 1 To .Recipients.Count
               .Recipients(Recpt).Resolve showdialog:=False
            Next

            ' Attach a file to the message.
            Set MapiAttachment = MapiMessage.Attachments.Add
            With MapiAttachment
                .Name = "Customers.txt"
                .Type = mapiFileData
                .Source = "C:\Examples\Customers.txt"
                .ReadFromFile filename:="C:\Examples\Customers.txt"
                .position = 2880
            End With

            ' Assign the text, subject, and importance of the message.
            .subject = "My Subject"
            .Text = "This is the text of my message." & vbCrLf & vbCrLf
            .importance = mapiHigh

            ' View the message in Microsoft Exchange before sending. Set
            ' the ShowDialog argument to False if you want to send the
            ' message without viewing it in Microsoft Exchange.
            .Send showdialog:=True
        End With
        Set MapiSession = Nothing  ' Clear the object variable.

     MAPIExit:
        Exit Sub

     MAPITrap:
        errObj = Err - vbObjectError  ' Strip out the OLE automation error.
        Select Case errObj
            Case 275                  ' User cancelled sending of message.
                Resume MAPIExit
            Case Else
                errMsg = MsgBox("Error " & errObj & " was returned.")
                Resume MAPIExit
            End Select
     End Sub