Execute batch script once for multiple emails Execute batch script once for multiple emails vba vba

Execute batch script once for multiple emails


Assumptions

  • OP will receive exactly three emails per day (though that iscustomizable in the code)
  • The subjects will always begin with "ORDERS EXTRACT -" and no otheremails will begin with that code
  • OP would like to run Complete.bat once per day upon receipt of thethird ORDERS EXTRACT email.
  • OP aready has a rule set up to run SaveAttachtoDisk upon receipt ofan ORDERS EXTRACT email. This rule can be changed to runCategorySaveAndComplete
  • OP is using Outlook 2013 or later

Proposed Solution

The below code will save the attachments for each Orders Extract email and then check to see if all three have been received. I elected not to use .Find and .FindNext as those methods cannot use wildcards and would therefore require hardcoding the category names. I also elected not to use .Restrict as there are only three items for which we are searching.

That said, solutions with .Find and .Restrict would be valid as well and would work better than the below under certain conditions, such as a user with many items consistently in their Inbox.

Please note that the expected count of Orders Extract emails, subject string to match against, and previous dates to check can all be set via constants. I implemented the previous date check in case OP wanted to check each prior day as well.

Option ExplicitPublic Const C_ExpectedOrderCount As Integer = 3 'Set number of expected emails for categoriesPublic Const C_SubjectFormat As String = "ORDERS EXTRACT - *"Public Const C_PrevDatesToCheck As Integer = 0 'If the Outlook app may not be open every day, set this to the number of prior days the script should also check.Public Sub CategorySaveAndComplete(itm As Outlook.MailItem)    'Do not take any action if this is not an ORDERS EXTRACT email.    If itm.Subject Like C_SubjectFormat Then        Dim objAtt As Outlook.Attachment        Dim SaveFolder As String        SaveFolder = "D:\Orders\"        For Each objAtt In itm.Attachments            objAtt.SaveAsFile SaveFolder & "\" & objAtt.DisplayName            objAtt.Delete        Next        itm.Save        'Check all emails in Inbox for ORDERS EXTRACT - * - DATE        Dim Item As Object        Dim objNS As Outlook.NameSpace        Set objNS = GetNamespace("MAPI")        Dim olFolder As Outlook.MAPIFolder        Set olFolder = objNS.GetDefaultFolder(olFolderInbox)        Dim iLoop As Integer        Dim iCount As Integer        Dim DateCheck As Date        For iLoop = 0 To C_PrevDatesToCheck            'Reset DateCheck and iCount if we are looping through days            DateCheck = DateSerial(Year(Date), Month(Date), Day(Date)) - iLoop            iCount = 0            'Loop through mail items            For Each Item In olFolder.Items                If Item.Class = 43 Then                    'This is an email. Check if it matches our criteria.                    If Item.Subject Like C_SubjectFormat And CDate(CLng(Item.ReceivedTime)) = DateCheck Then iCount = iCount + 1                End If            Next            'If we have met the expected targets, then run the batch file.            If iCount = C_ExpectedOrderCount Then                'We have exactly the expected number of items. Run the batch file.                Shell "D:\Orders\Complete.bat"            ElseIf iCount > C_ExpectedOrderCount Then                'More items than expected. Check if user is OK with running batch file; if so, run it now.                If MsgBox("More order extracts than expected were received. Expected " & _                C_ExpectedOrderCount & "; received " & iCount & " for " & Format(DateCheck, "mmm d, yy") & _                ". Would you like to run the Complete.bat file now?", vbYesNo) = vbYes Then Shell "D:\Orders\Complete.bat"            End If        Next iLoop    End IfEnd Sub