Only run if email has attachment - vba

Question

I want the below code to run when a specific subject appears in an email.
Also to only run if that email has an attachment.
Outlook ignores the attachment part of the rule, and tries to run the code even if the attachment is not there (it seems to only care about the subject).
How do I incorporate a check for attachment in the code?
Public Sub SaveAttachmentsThenOpen(MItem As Outlook.MailItem)
Dim oMail As Variant
Dim oReply As Outlook.MailItem
Dim oItems As Outlook.Items
Dim Msg As Outlook.MailItem
Dim oAttachment As Outlook.Attachment
Dim StrBody As String
Dim oRep As MailItem
Dim sSaveFolder As String
Dim Att As String
Dim Attname As String
Dim sht As Object
Dim Rng As Range
Dim s As String
Dim myAttachments As Outlook.Attachments
Dim XLApp As Object
Dim XlWK As Object
Dim strPaste As Variant
Set oApp = New Outlook.Application
Set oNs = oApp.GetNamespace("MAPI")
Set XLApp = CreateObject("Excel.Application")
With XLApp
.Visible = True
.ScreenUpdating = True
.Workbooks.Open ("C:\Directory\data.xlsx")
.Workbooks.Open ("C:\Directory\WB.xlsb")
End With
Dim strText As String
strText = ".xls"
sSaveFolder = "C:\Directory\TPS_Reports\"
For Each oAttachment In MItem.Attachments
If InStr(1, oAttachment.FileName, strText) > 0 Then
oAttachment.SaveAsFile sSaveFolder & oAttachment.FileName
Attname = oAttachment.FileName
Att = sSaveFolder & oAttachment.FileName
Exit For
End If
Next oAttachment
Set oAttachment = Nothing
XLApp.Workbooks.Open (Att)
XLApp.Visible = True
XLApp.Run ("WB.XLSB!MacroName")
Set sht = XLApp.Workbooks(Attname).ActiveSheet
Set Rng = sht.UsedRange
s = "<table border=1 bordercolor=black cellspacing=0>"
For rw = Rng.Row To Rng.Rows.Count
s = s & "<tr>"
For col = Rng.Column To Rng.Columns.Count
s = s & "<td>" & sht.Cells(rw, col) & "</td>"
Next
s = s & "</tr>"
Next
s = s & "</table>"
Set oRep = MItem.ReplyAll
With oRep
StrBody = "Hello"
.HTMLBody = s
.Send
End With
With XLApp
.DisplayAlerts = False
End With
XLApp.Workbooks(Attname).Save
XLApp.Quit
With XLApp
.DisplayAlerts = True
End With
End Sub

Answer 1

Try waiting for the mail to be in the inbox before checking for the attachment.
Code for the ThisOutlookSession module
Restart Outlook or run Application_Startup manually.
Private WithEvents myItems As Items
Private Sub Application_Startup()
Dim myInbox As folder
Set myInbox = Session.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
End Sub
Private Sub myItems_ItemAdd(ByVal Item As Object)
If TypeOf Item Is mailItem Then
If Item.Attachments.Count > 0 Then
SaveAttachmentsThenOpen Item
End If
End If
End Sub
Private Sub test()
myItems_ItemAdd ActiveInspector.currentItem
End Sub