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.
Subscribe to:
Post Comments (Atom)
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.