Thực thi tập lệnh batch một lần cho nhiều email

Question

Tôi có nhiều email đến (Mỗi ngày tôi nhận được 3 email cho Đơn đặt hàng cho 3 Danh mục). Chủ đề email có định dạng:

"ĐƠN ĐẶT HÀNG TẮT - [Danh mục] - [Ngày]".

Nơi [Danh mục] có thể là Category 1, Category 2 hoặc Category 3. [Ngày] là ngày email được gửi ở định dạng DD/MM/YYYY.

Tôi có cài đặt quy tắc để tìm kiếm 'Đơn đặt hàng' rồi gọi mã bên dưới.

Tôi muốn chạy Complete.bat sau khi tất cả các tệp đính kèm email đã được lưu và tôi chỉ muốn gọi nó một lần.

Tôi đã cố gắng thực hiện việc này bằng cách tạo một phụ khác có tên là saveAttachtoDisk_CATEGORY1(itm) chỉ được gọi khi tìm thấy "Danh mục 1" trong chủ đề. Sau đó, nó lưu tệp đính kèm nhưng cũng tìm kiếm một danh mục 1 trong chủ đề VÀ cũng tìm kiếm ngày hôm qua.

Tôi muốn một giải pháp tốt hơn không phụ thuộc vào ngày tháng. Biến toàn cầu có thể hoạt động ở nơi tôi đặt biến là 1 sau đó chạy Complete.bat được gửi và sau đó trong tương lai nếu biến = 1 thì không chạy Complete.bat. Bạn không chắc chắn nên đặt biến này ở đâu (Biến toàn cục?) Vì cả hai mô-đun phụ dường như không đúng chỗ để đặt biến này và tham chiếu nó.

Cả hai mô-đun này đều được lưu trong phần 'Mô-đun' của Microsoft Outlook VBA.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem) 
    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 
End Sub 

mô-đun khác:

Public Sub saveAttachtoDisk_CATEGORY1(itm As Outlook.MailItem) 
    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 
    If InStr(1, itm.Subject, "ORDERS EXTRACT - Category 1 -" & Format(Date, "dd/mm/yyyy")) Then 
     Shell "D:\Orders\Complete.bat" 
    End If 
End Sub 

Answer 1

Giả

• OP sẽ nhận được đúng ba email mỗi ngày (mặc dù đó là tùy biến trong code)
• Các đối tượng sẽ luôn bắt đầu bằng "ĐƠN ĐẶT HÀNG ĐẶT HÀNG" và không có khác email sẽ bắt đầu bằng mã đó
• OP muốn chạy Complete.bat một lần mỗi ngày khi nhận được email ĐẶT HÀNG ĐẶT HÀNG thứ ba.
• Khu vực OP có quy tắc được thiết lập để chạy SaveAttachtoDisk khi nhận được email ĐẶT HÀNG ĐẶT HÀNG. Quy tắc này có thể được thay đổi để chạy CategorySaveAndComplete
• OP đang sử dụng Outlook 2013 hay muộn

đề xuất giải pháp

Mã dưới đây sẽ lưu các file đính kèm cho mỗi đơn đặt hàng Trích xuất email và sau đó kiểm tra xem nếu cả ba đã được nhận. Tôi đã chọn không sử dụng .Find và .FindNext vì những phương thức đó không thể sử dụng ký tự đại diện và do đó sẽ yêu cầu mã hóa cứng tên danh mục. Tôi cũng đã chọn không sử dụng. Hạn chế vì chỉ có ba mục mà chúng tôi đang tìm kiếm.

Điều đó nói rằng, các giải pháp với .Find và .Restrict sẽ hợp lệ và sẽ hoạt động tốt hơn bên dưới trong các điều kiện nhất định, chẳng hạn như người dùng có nhiều mục nhất quán trong Hộp thư đến của họ.

Xin lưu ý rằng số lượng đơn đặt hàng dự kiến ​​Trích xuất email, chuỗi chủ đề để đối sánh và ngày trước đó để kiểm tra tất cả có thể được đặt qua hằng số. Tôi đã thực hiện kiểm tra ngày trước đó trong trường hợp OP muốn kiểm tra từng ngày trước đó.

Option Explicit 

Public Const C_ExpectedOrderCount As Integer = 3 'Set number of expected emails for categories 
Public 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 If 
End Sub