すべてのRSSフィードのすべてのタイトルを比較して重複を削除するにはどうすればよいですか？

Question

ALL TITLES in ALL RSS FEEDSを比較して重複を削除する方法があるのだろうかと思います。

私はたくさんのフィードを読んでいます。多くの人が複数のフォーラムにクロスポストしてから、同じものを見ることになります。RSS複数回フィード。

すべての

Option Explicit 
Public Sub DupeRSS() 
    Dim olNs As Outlook.NameSpace 
    Dim RSS_Folder As Outlook.MAPIFolder 

    Set olNs = Application.GetNamespace("MAPI") 
    Set RSS_Folder = olNs.GetDefaultFolder(olFolderRssFeeds) 

    'Process Current Folder 
    Example RSS_Folder 
End Sub 
Public Sub Example(ByVal ParentFolder As Outlook.MAPIFolder) 
    Dim itm As Object, itms As Items, dupes As Object, i As Long, k As Variant 

    Set dupes = CreateObject("Scripting.Dictionary") 
    Set itms = ParentFolder.Items 

    For i = itms.Folders.Count To 1 Step -1 
     Set itm = itms(i) 
     If TypeOf itm Is PostItem Then 
      If dupes.Exists(itm.Subject) Then itm.Delete Else dupes(itm.Subject) = 0 
     Else 
      Example itm  'Recursive call for Folders 
     End If 
    Next i 

    'Show dictionary items 
    If dupes.Count > 0 Then 
     For Each k In dupes 
      Debug.Print k 
     Next 
    End If 

    Set itm = Nothing: Set itms = Nothing: Set dupes = Nothing 
End Sub 

おかげで.....私は、スクリプトは次のようになりますと思いますが、dupesを削除していないようです！

Answer 1

は私のように見えます誤解されました 上のあなた以前question、

は多分これはあなたがやろうとし、次のコードは、セーブ/コレクションのすべてのアイテムの件名を追加し、複数のフォルダを検索し続け、それがduplicates-見つかった場合は削除するものです

Option Explicit 
Public Sub DupeRSS() 
    Dim olNs As Outlook.NameSpace 
    Dim RSS_Folder As Outlook.MAPIFolder 
    Dim DupItem As Object 

    Set DupItem = CreateObject("Scripting.Dictionary") 
    Set olNs = Application.GetNamespace("MAPI") 
    Set RSS_Folder = olNs.GetDefaultFolder(olFolderRssFeeds) 

' // Process Current Folder 
    Example RSS_Folder, DupItem 
End Sub 
Public Sub Example(ByVal ParentFolder As Outlook.MAPIFolder, _ 
        ByVal DupItem As Object) 
    Dim Folder As Outlook.MAPIFolder 
    Dim Item As Object 
    Dim Items As Items 
    Dim i As Long 

    Set Items = ParentFolder.Items 
    Debug.Print ParentFolder.Name 

    For i = Items.Count To 1 Step -1 
     DoEvents 

     If TypeOf Items(i) Is PostItem Then 
      Set Item = Items(i) 
      If DupItem.Exists(Item.Subject) Then 
       Debug.Print Item.Subject ' Print on Immediate Window 
       Debug.Print TypeName(Item) ' Print on Immediate Window 
       Item.Delete 
      Else 
       DupItem.Add Item.Subject, 0 
       Debug.Print DupItem.Count, Item.Subject 
      End If 
     End If 

    Next i 

' // Recurse through subfolders 
    If ParentFolder.Folders.Count > 0 Then 
     For Each Folder In ParentFolder.Folders 
      Example Folder, DupItem 
      Debug.Print Folder.Name 
     Next 
    End If 

    Set Folder = Nothing 
    Set Item = Nothing 
    Set Items = Nothing 
End Sub 

Answer 2

---

Option Explicit 

'Required - VBA Editor -> Tools -> References: Microsfot Outlook XXX Object Library 
'Required - VBA Editor -> Tools -> References: Microsfot Scripting Runtime (Dictionary) 

Public Sub RemoveRSSduplicates() 
    Dim olNs As Outlook.Namespace, olApp As Object, rssFolder As Folder, d As Dictionary 

    Set olApp = GetObject(, "Outlook.Application") 
    Set olNs = olApp.GetNamespace("MAPI") 
    Set rssFolder = olNs.GetDefaultFolder(olFolderRssFeeds) 
    Set d = CreateObject("Scripting.Dictionary") 

    ProcessOutlookRSSFeeds rssFolder, d 
End Sub 

---

Public Sub ProcessOutlookRSSFeeds(ByVal rssFolder As Folder, ByRef d As Dictionary) 
    Dim fldr As Folder, itm As Object 

    For Each fldr In rssFolder.Folders 
     If fldr.Items.Count > 0 Then 
      For Each itm In fldr.Items 
       If TypeOf itm Is PostItem Then 
        If Not d.Exists(itm.Subject) Then d(itm.Subject) = 0 Else itm.Delete 
       End If 
      Next 
     End If 
    Next 
End Sub 

---

注怒鳴るの変更を試してみてください：（EX Dim Items As Items）他のオブジェクトを非表示になります変数名を避ける