Public Function SendEmail(MailTo As String, CCTo As String, BCCTo As String, Subject As String, Message As String, Optional EditBeforeSending As Boolean = False, Optional Attachment As String) As Boolean
Const olByValue = 1
Dim OL As Object
Dim MyMailItem As Object
Dim AName As String
Dim A As Long
'Dim OL As Outlook.Application
'Dim MyMailItem As Outlook.MailItem
Const olMailItem = 0
Set OL = CreateObject("Outlook.Application")
Set MyMailItem = OL.CreateItem(olMailItem)
With MyMailItem
.To = MailTo
.CC = CCTo
.BCC = BCCTo
.Subject = Subject
If Attachment <> "" Then
If Dir(Attachment) <> "" Then
'Display it without the '.lnk'
AName = Attachment
A = InStr(1, AName, "\")
While A <> 0
AName = Mid$(AName, A + 1)
A = InStr(1, AName, "\")
Wend
A = InStr(1, AName, ".")
If A > 0 Then
AName = Left$(AName, A - 1)
End If
If AName = "" Then AName = Attachment 'Make sure we have something at least
.Attachments.Add Attachment, olByValue, 1, AName ' Add A Copy (Not Shortcut)
End If
.body = vbCr & Message
Else
.body = Message
End If
If EditBeforeSending Then
.Display
Else
On Error Resume Next
.Send
If Err.Number <> 0 Then
MsgBox "Email not sent!", vbExclamation
Err.Clear
End If
On Error GoTo 0
End If
End With
Set MyMailItem = Nothing
Set OL = Nothing
End Function