Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
884 views
in Technique[技术] by (71.8m points)

vba - How can I compare all the titles of all RSS feeds and delete duplicates?

I'm wondering if there is a way to compare ALL TITLES in ALL RSS FEEDS and delete the duplicates.

I read through a lot of RSS Feeds, and it's obvious that a lot of people cross-post to several forums, and then I end up seeing the same RSS Feed multiple times.

I think the script will look something like this, but it doesn't seem to delete dupes.....

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

enter image description here

Thanks to all!!

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

Maybe this is what your trying to do, the following code saves/adds all the Items subject line to the collection and then continues to search multiple folders and then deletes if it finds 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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...