Wednesday 22 December 2010

Outlook Email using VBA (Updated)

This is an update to the code supplied here.  The previous article enabled you to send an email though Outlook using early binding.  The code below uses late binding, this means you do not need to worry about Outlook versions.
As before it includes the subject and message body fields as well as the To, Cc and Bcc fields within a standard email format. 
The code could easily be changed to loop through arrays or collections of values for many of these fields.
Private Sub SendOutlookEmail()
'-- Creates and sends a new e-mail message with Outlook --

    ' These are members of the referenced object model which _
      are unavailable due to late binding.  They have been _
      replaced with the numbers they represent

    Const olMailItem    As Integer = 0
    Const olTo          As Integer = 1
    Const olCc          As Integer = 2

    Dim oOutlook        As Object 'Outlook Application
    Dim oMailMsg        As Object 'Outlook MailItem
    Dim oRecipient      As Object 'Outlook Recipient
    Dim oRecipType      As Object 'Outlook Recipient Type

    On Error GoTo ErrTrap

    ' Create the Outlook session
    Set oOutlook = CreateObject("Outlook.Application")

    ' Create the message
    Set oMailMsg = oOutlook.CreateItem(olMailItem)

    With oMailMsg
        ' Request a receipt ?
        .ReadReceiptRequested = False
        ' Keep copy in 'Sent Items' ?
        .DeleteAfterSubmit = False
        ' Your email address or 'team mailbox' address
        .SentOnBehalfOfName = "YourEmail@Address.com"
        ' Message subject
        .Subject = "Subject Here"
        ' Add message body
        .Body = "Email Message Here"

         'Add 'To' recipient(s)
        Set oRecipient = .Recipients.Add _
            ("SomeoneElses@EmailAddress.com; AnotherPerson@Email.com")
        oRecipient.Type = olTo
         'Add another 'To' recipient
        Set oRecipient = .Recipients.Add _
            ("SomeoneElses@EmailAddress.com")
        oRecipient.Type = olTo
        ' Add 'Cc' recipient(s)
        Set oRecipient = .Recipients.Add _
            ("SomeoneElses@EmailAddress.com")
        oRecipient.Type = olCc

        ' Loop through an array to attach files
        For l = 0 To UBound(varFile)
            If Not IsEmpty(varFile(l)) Then
                .Attachments.Add varFile(l)
            End If
        Next l

        ' Display to user or Send email
        '.Send
        .Display

    End With

ErrTrap:
    Set oOutlook = Nothing
    Set oMailMsg = Nothing
    Set oRecipient = Nothing
    Set oRecipType = Nothing

    Select Case Err.Number
        Case Is = 0
            ' All okay, continue
        Case Is = -284147707
            MsgBox "You have exceeded the storage limit on your mailbox. " _
                & "Delete some mail from your mailbox or contact your " _
                & "system administrator to adjust your storage limit." _
                 , vbInformation, "Error Message"
        Case Else
            MsgBox "An error has occured:" & vbCrLf & vbCrLf _
                & Err.Number & " - " & Err.Description, "OutlookEmailFunction"
    End Select
End Sub

As always, if you have any questions do let us know via the comments section.

No comments:

Post a Comment

Please, no purely anonymous comments, they will be deleted; always use a name for ease of reference by other commenters.