asked on
SendEmail rs!Recipient, rs!Sender, rs!Body, rs!Subject, rs!CC, rs!BCC
Private Sub SendEmail(Optional strEmailAdd As String, Optional strFrom As String, _
Optional strBody As String, Optional strSubject As String, _
Optional strCC As String, Optional strBCC As String)
On Error GoTo errHandler
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim objOutlookFrom As Outlook.MailItem
Dim objOutlookInbox As Outlook.MAPIFolder
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message. This can be a variable or pulled form a table if desired.
If Len(strEmailAdd) > 0 Then
Set objOutlookRecip = .Recipients.Add(strEmailAdd)
objOutlookRecip.Type = olTo
End If
' Set sender
.SentOnBehalfOfName = strFrom
' Set CC
If Len(strCC) > 0 Then
.CC = strCC
End If
' Set BCC
If Len(strBCC) > 0 Then
.BCC = strBCC
End If
' Set the Subject, Body, and Importance of the message.
.Subject = strSubject
.HTMLBody = strBody
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
'Set objOutlookAttach = .Attachments.Add(strAttach)
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
If Not .Recipients.ResolveAll Then
For Each objOutlookRecip In .Recipients
If Not objOutlookRecip.Resolved Then
MsgBox "Error on e-mail name " & objOutlookRecip & ". I will open the e-mail so you can correct it before you send it."
End If
Next
.Display
Else:
.Save
.Send
End If
End With
exitHere:
Set objOutlook = Nothing
Exit Sub
errHandler:
Select Case Err
Case Else
MsgBox "Error Number: " & Err.Number & vbNewLine & "Description: " & Err.Description, vbCritical, "Error"
GoTo exitHere
End Select
End Sub