Outlook 2010 VBA issue

[litestream]

I am using the VBA below to autoreply to an email from the Inbox in Outlook 2010 when a button is clicked on the ribbon.

Everything works fine unless the command button is accidentally clicked twice, when the opened reply window is moved behind Outlook and an error message 800200009 is generated. I put in some error handling for this and the error 424 which occurred afterwards.

The error handling seems to work ok, except that I want the reply window generated from VBA to come to the front of Outlook.

Can anyone help with this please.

Here is my code:

Public Sub ReplyCurrentMsgEng()

On Error GoTo ErrorHandler
Const TEXT_FILE_PATH As String = "\\AutoreplyTemplates\autoreply_Eng.html"
Dim obj As Object
Dim msg As Outlook.MailItem
Dim msgReply As Outlook.MailItem
Dim fileNum As Integer
Dim fileContents As String
Set obj = GetCurrentItem
If TypeName(obj) = "MailItem" Then
Set msg = obj
Set msgReply = msg.Reply
fileNum = FreeFile
Open TEXT_FILE_PATH For Input As #fileNum
fileContents = Input$(LOF(fileNum), 1)
Close #fileNum
With msgReply
.Subject = "Reply from Customer Service Team"
.BodyFormat = olFormatHTML
.HTMLBody = fileContents
.Display
End With
End If

ProcedureDone:

Exit Sub

ErrorHandler:

Select Case Err.Number

Case 800200009

Exit Sub

Case 424

Exit Sub

'Case Else

'All outstanding errors

'MsgBox Err.Number & ": " & Error.Description

End Select

Resume ProcedureDone

End Sub

 

[Diane Poremsky]

Hmmm. Here it goes through the macro twice, the first time hitting the error handler, the second time creating the message. If i remove the error handler, it stops on the second time through because it can't reply to the reply....

I switch the one error line to
On Error GoTo ProcedureDone

and removed the errorhandler, using these lines at the end:
Exit Sub ' exits when the macro works

ProcedureDone:
MsgBox "You need to select a received message"

The 424 object required error is because this fails to set an object:

Set msg = obj

Set msgReply = msg.Reply