Excel: Unable to trap 287 error with Outlook Security Dialog
 

Hi,

I would very much appreciate it if someone can save my sanity and help
me with the following problem.

I am sending automated e-mails using the Outlook object model from
Excel. The problem being when 'No' is clicked on the Outlook Security
Dialog Box I am unable to trap the error in Excel and my application
falls over with Error: '287' .

Here is my code...

Public Function SendEmailToGroup(strAttachPathFilename As String,
strGroupName As String) As Boolean
On Error GoTo ErrorMsgs

Dim OL As Object ' Outlook instantiation
Dim EmailItem As Object ' A new mail item (e-mail)

Dim oEmailGroup As EmailGroup
Dim strRecipientList As String

Set OL = CreateObject("Outlook.Application") ' New Outlook application

Set EmailItem = OL.CreateItem(olMailItem) ' new MailItem

Set oEmailGroup = New EmailGroup

If Not oEmailGroup.LoadByName(strGroupName) Then
Err.Raise ERR_BAD_EMAIL_GROUPNAME, , "Email group " & strGroupName
& " was not found"
End If

strRecipientList = "" & oEmailGroup.GetRecipientList

With EmailItem
.Subject = "Five Overnights"
.Body = strEmailContent
.To = "" & strRecipientList
.Importance = olImportanceNormal
.Attachments.Add "" & strAttachPathFilename


If EmailItem.Send Then

End With


SendEmailToGroup = True


strRecipientList = ""
Set EmailItem = Nothing
Set OL = Nothing
Set oEmailGroup = Nothing

Exit Function

ErrorMsgs:


Err.Clear

MsgBox "E-mail Configuration incorrect. Workbook not sent." _
& vbCrLf & vbCrLf & " Workbook saved in default save directory.",
vbExclamation, "" & strGroupName & ": Error Sending Report"

SendEmailToGroup = False

strRecipientList = ""
Set EmailItem = Nothing
Set OL = Nothing
Set oEmailGroup = Nothing


Exit Function

End Function


Thanks,

Lex