I wrote a macro that automatically replies to an e-mail in Outlook. It downloads an Excel attachment, performs the action in Excel and replies. Generally, everything works, but the macro compiles only once, when I get next email with the same subject, I get error 1004. Do you have any suggestions for solving the problem? 
Code
Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim objMsg As Outlook.MailItem
Dim MessageInfo
Dim objAttachments As Outlook.Attachments
Dim strFolderpath As String
Dim strFile As String
Dim xExcelFile As String
Dim xExcelApp As Excel.Application
Dim xWb As Excel.Workbook
Dim xWs As Excel.Worksheet
Dim xExcelRange As Excel.Range
Dim objAutoReply As Outlook.MailItem
Dim strReplyBody As String
Dim objMail As Outlook.MailItem
Dim r As Recipient
Dim i As Long
Dim lngCount As Long
Dim currenttime As Date
If TypeName(Item) = "MailItem" Then
Set objMsg = Item
If Left(objMsg.Subject, 7) = "TEST" Then
currenttime = Now
Do Until currenttime + TimeValue("00:02:00") <= Now
Loop
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
For i = lngCount To 1 Step -1
strFolderpath = "C:\Users\XXXXX"
strFile = objAttachments.Item(i).FileName
If Right(strFile, 4) = "xlsx" Then
strFile = strFolderpath & strFile
objAttachments.Item(i).SaveAsFile strFile
xExcelFile = strFile
Set xExcelApp = CreateObject("Excel.Application")
Set xWb = xExcelApp.Workbooks.Open(xExcelFile)
Set xWs = xWb.Sheets(1)
xWs.Activate
Set xExcelRange = xWs.Range("A1")
xExcelRange.Activate
xExcelApp.Visible = True
Range("C4") = "XXXX"
Range("D4").Formula = "=D2-D5"
Range("E4").Formula = "=E2-E5"
Range("D4:E5").Select
Selection.Copy
Range("D4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G2").Formula = ""
Range("G10").Select
ActiveWorkbook.Close Savechanges:=True
Set objMail = Item
Set objAutoReply = objMail.ReplyAll
strReplyBody = objAutoReply.HTMLBody
objAutoReply.Attachments.Add strFile
objAutoReply.HTMLBody = "<HTML><BODY>Good morning.</HTML></BODY>" & strReplyBody
objAutoReply.Send
End If
Next i
End If
End If
ExitNewItem:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ExitNewItem
End Sub