Option Compare Database
Public Function Email(strTo As String, _
strCc As String, _
strBcc As String, _
strSubject As String, _
strBody As String, _
strAttachment As String)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim objSaveMail As Redemption.SafeMailItem
On Error GoTo ErrorMsgs
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
.Subject = strSubject
'.To = ""
.To = strTo
.CC = strCc
.BCC = strBcc
.Body = strBody
' Set objOutlookRecip = .Recipients.Add("")
' objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
' objOutlookRecip.Type = olCC
' Set the Subject, Body, and Importance of the message.
' .Subject = "This is an Automation test with Microsoft Outlook"
' .Body = "Last test." & vbCrLf & vbCrLf
' .Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsNull(strAttachment) And strAttachment <> "" Then 'if there's an attachment add it
objOutlookMsg.Attachments.Add strAttachment, , , Left$(strAttachment, 25)
End If
' If Not IsMissing(AttachmentPath) Then
' Set objOutlookAttach = .Attachments.Add(AttachmentPath)
' End If
' Resolve each Recipient's name.
' For Each objOutlookRecip In .Recipients
' If Not objOutlookRecip.Resolve Then
' objOutlookMsg.Display
' End If
' Next
Set objSafeMail = New Redemption.SafeMailItem
objSafeMail.Item = objOutlookMsg
objSafeMail.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Set objOutlookRecip = Nothing
Set objOutlookAttach = Nothing
ErrorMsgs:
If Err.Number <> "0" Then
MsgBox Err.Number & Err.Description
End If
End Function
