प्रत्येक पाश के लिए: कुछ आइटम को छोड़ दिया जब आउटलुक मेलबॉक्स के माध्यम से पाशन आइटम

Question

मैं VBA कोड है कि विकसित करने के लिए चाहता था हटाने के लिए:

1. मेलबॉक्स
2. में सभी ईमेल आइटम के माध्यम से लूप्स अगर कोई अन्य किसी भी प्रकार के कर रहे हैं आइटम कहते हैं कि "कैलेंडर आमंत्रण" उस आइटम को छोड़ देता है।
3. अनुलग्नकों के साथ ईमेल पता चल गया
4. संलग्न फाइल है, तो ".xml" विस्तार और इसे में कोई विशेष शीर्षक, एक डायरेक्टरी में बचत होती है, नहीं तो यह खोज
5. रखता है सभी ईमेल का .xml संलग्नक शामिल रहता है चरण 4 करने के बाद "हटाए गए आइटम" फ़ोल्डर और लूपिंग द्वारा उस फ़ोल्डर में सभी ईमेल हटा देता है।

कोड सही EXCEPT काम करता है; उदाहरण के लिए

1. आपके मेलबॉक्स में उनमें से प्रत्येक से जुड़ी ".xml" फ़ाइल के साथ 8 ईमेल प्राप्त हुए हैं।
2. कोड
3. चलाएं आप देखेंगे कि 8 में से केवल 4 आइटम सफलतापूर्वक संसाधित किए जाते हैं, अन्य 4 उनकी स्थिति में रहते हैं।
4. यदि आप कोड फिर से चलाते हैं, तो अब 2 आइटम सफलतापूर्वक संसाधित किए जाएंगे और अन्य 2 आपके मेलबॉक्स में बने रहेंगे।

समस्या: कोड चलाने के बाद, यह सभी फ़ाइलों को संसाधित करना और उन्हें प्रत्येक भाग में उनमें से आधा नहीं हटा देना चाहिए। मैं चाहता हूं कि यह सभी वस्तुओं को एक ही रन पर संसाधित करे।

बीटीडब्ल्यू, यह कोड हर बार जब मैं Outlook खोलता हूं तो चलता है।

Private Sub Application_Startup() 
'Initializing Application_Startup forces the macros to be accessible from other offic apps 

'Process XML emails 

Dim InboxMsg As Object 

Dim DeletedItems As Outlook.Folder 
Dim MsgAttachment As Outlook.Attachment 
Dim ns As Outlook.NameSpace 
Dim Inbox As Outlook.Folder 

Dim fPathTemp As String 
Dim fPathXML_SEM As String 
Dim fPathEmail_SEM As String 
Dim i As Long 
Dim xmlDoc As New MSXML2.DOMDocument60 
Dim xmlTitle As MSXML2.IXMLDOMNode 
Dim xmlSupNum As MSXML2.IXMLDOMNode 

    'Specify the folder where the attachments will be saved 
    fPathTemp = "some directory, doesn't matter" 
    fPathXML_SEM = "some directory, doesn't matter" 
    fPathEmail_SEM = "some directory, doesn't matter" 

    'Setup Outlook 
    Set ns = GetNamespace("MAPI") 
    Set Inbox = ns.Folders.Item("mailbox-name").Folders("Inbox") 
    Set DeletedItems = ns.Folders.Item("mailbox-name").Folders("Deleted Items") 


    'Loop through all Items in Inbox, find the xml attachements and process if they are the matching reponses 
    'On Error Resume Next 
    For Each InboxMsg In Inbox.Items 
     If InboxMsg.Class = olMail Then 'if it is a mail item 

      'Check for xml attachement 
      For Each MsgAttachment In InboxMsg.Attachments 

       If Right(MsgAttachment.DisplayName, 3) = "xml" Then 

        'Load XML and test for the title of the file 
        MsgAttachment.SaveAsFile fPathTemp & MsgAttachment.FileName 
        xmlDoc.Load fPathTemp & MsgAttachment.FileName 
        Set xmlTitle = xmlDoc.SelectSingleNode("//title") 
        Select Case xmlTitle.Text 
         Case "specific title" 
          'Get supplier number 
          Set xmlSupNum = xmlDoc.SelectSingleNode("//supplierNum") 
          'Save the XML to the correct folder 
          MsgAttachment.SaveAsFile fPathXML_SEM & xmlSupNum.Text & "_" & Format(Date, "yyyy-mm-dd") & ".xml" 
          'Save the email to the correct folder 
          InboxMsg.SaveAs fPathEmail_SEM & xmlSupNum.Text & "_" & Format(Date, "yyyy-mm-dd") & ".msg" 
          'Delete the message 
          InboxMsg.Move DeletedItems 
         Case Else 

        End Select 
        'Delete the temp file 
        On Error Resume Next 
        Kill fPathTemp & MsgAttachment.FileName 
        On Error GoTo 0 
        'Unload xmldoc 
        Set xmlDoc = Nothing 
        Set xmlTitle = Nothing 
        Set xmlSupNum = Nothing 
       End If 
      Next 
     End If 
    Next 

    'Loop through deleted items and delete 
    For Each InboxMsg In DeletedItems.Items 
     InboxMsg.Delete 
    Next 

    'Clean-up 
    Set InboxMsg = Nothing 
    Set DeletedItems = Nothing 
    Set MsgAttachment = Nothing 
    Set ns = Nothing 
    Set Inbox = Nothing 
    i = 0 

End Sub 

Answer 1

संभावित कारण: आप इस InboxMsg.Move, करते हैं एक है कि ले जाया गया था में एक स्थान से टकरा कर रहे हैं के बाद अपने इनबॉक्स में संदेशों के सभी सूची। तो आप उनमें से कुछ को छोड़ने के अंत में। यह वीबीए के For Each निर्माण के साथ एक बड़ी परेशानी है (और यह या तो संगत प्रतीत नहीं होता है)।

संभावना समाधान:

For i = Inbox.Items.Count To 1 Step -1 'Iterates from the end backwards 
    Set InboxMsg = Inbox.Items(i) 

साथ

For Each InboxMsg In Inbox.Items 

बदलें इस तरह आप सूची के अंत से पिछड़े पुनरावृति।जब आप हटाए गए आइटमों पर एक संदेश ले जाते हैं, तो इससे कोई फर्क नहीं पड़ता कि सूची में निम्न आइटम एक-एक करके बंप किए जाते हैं, क्योंकि आप पहले से ही उन्हें संसाधित कर चुके हैं।

Answer 2

अक्सर उन पर लूप करते समय वस्तुओं के एक (उप) सेट की सामग्री को संशोधित करना एक अच्छा विचार नहीं है। आप अपने कोड को संशोधित कर सकते हैं ताकि यह पहले उन सभी वस्तुओं की पहचान करे जिन्हें संसाधित करने की आवश्यकता है, और उन्हें Collection में जोड़ दिया गया है। फिर उस संग्रह में सभी वस्तुओं को संसाधित करें।

असल में आपको इनबॉक्स से आइटम्स को हटा नहीं देना चाहिए, जबकि आप इसकी सामग्री के माध्यम से लूपिंग कर रहे हैं। सबसे पहले उन सभी आइटमों को एकत्र करें जिन्हें आप संसाधित करना चाहते हैं (आपके इनबॉक्स लूप में), फिर जब आप लूपिंग कर लेंगे, तो आइटम के संग्रह को संसाधित करें।

यहाँ कुछ छद्म कोड जो इस दर्शाता है:

Private Sub Application_Startup() 

    Dim collItems As New Collection 

    'Start by identifying messages of interest and add them to a collection 
    For Each InboxMsg In Inbox.Items 
     If InboxMsg.Class = olMail Then 'if it is a mail item 
      For Each MsgAttachment In InboxMsg.Attachments 
       If Right(MsgAttachment.DisplayName, 3) = "xml" Then 
        collItems.Add InboxMsg 
        Exit For 
       End If 
      Next 
     End If 
    Next 

    'now deal with the identified messages 
    For Each InboxMsg In collItems 
     ProcessMessage InboxMsg 
    Next InboxMsg 

    'Loop through deleted items and delete 
    For Each InboxMsg In DeletedItems.Items 
     InboxMsg.Delete 
    Next 

End Sub 

Sub ProcessMessage(InboxMsg As Object) 
    'deal with attachment(s) and delete message 
End Sub