Outlook - Filtered Unread, Server duplicate emails & think Unread = False not work so errors (1 Viewer)

bignose2

Registered User.
Local time
Today, 15:59
Joined
May 2, 2010
Messages
232
Hi,

Really odd one this,
I load unread emails from outlook, works 95% of the time, no error.

From time to time & it seems on emails that are similar, I suspect identical duplicates!
it will crash, array out of bounds.

I am guessing when I mark as read, it then gets confused reading the next email.
I think I can trap the error & carry on & re-read but would like to understand more what's going on.

If I ignore the error & re-run the code, loads the next email fine, I can see Outlook is marking read. I put the msgbox below to delay but fairly sure not this anyway.

Is there a way to see the email UID or whatever its called here?

I will chase my provider (TSOHOST) & try to stop these duplicates, unless something I am doing or perhaps even outlook, I leave outlook running, minimized.

Code:
Sub Outlook_ExtractMessages()
    Dim oOutlook              As Object    'Outlook.Application
    Dim oNameSpace            As Object    'Outlook.Namespace
    Dim oFolder               As Object    'Outlook.folder
    Dim oItem                 As Object
    Dim oPrp                  As Object
    Const olFolderInbox = 6
    Const olMail = 43
    
    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")        'Bind to existing instance of Outlook
    If Err.Number <> 0 Then        'Could not get instance, so create a new one
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
    End If
 
    On Error GoTo Error_Handler    ' Guess wants resume next to get outlook but normal here but while testing turn off
    ' On Error GoTo 0 ' Turn off error trapping.
 
    ' For example, if "\\MyAccount\folder1\subfolder1" is displayed, replace the PickFolder line with:
    ' Set strFolderName = objNamespace.Folders("MyAccount").Folders("folder1").Folders("subfolder1")
    
    Dim dbs As DAO.Database
    Dim r As DAO.Recordset
    
    Dim IsSMS As Boolean
    Dim PlainSource As String
    Dim SourceShort As String
    Dim D1, D2, D3
    Dim LoopDates, SplitDates
    Dim i As Integer, iFiltered As Integer
    
    Dim AttCount As Integer
    
    Set dbs = CurrentDb
    
    'Open a table-type Recordset
    Set r = dbs.OpenRecordset("EmailPasteTable", dbOpenDynaset)

    Set oFolder = oNameSpace.Folders("Bookings@fpkennels.com").Folders("inbox")  '  .Folders("OlderEmails")
    
    ' WORKS    Debug.Print oFolder.UnReadItemCount
 
    Dim myItems As Object   '   Outlook.items
    Dim FilteredItems As Object    '  Outlook.items
    Dim myItem As Object    '    Outlook.MailItem
 
    Set myItems = oFolder.items
    Set FilteredItems = myItems.Restrict("[UnRead] = True")  '("[Categories] = 'Business'")   '("[UnRead] = True")
 
    '  Set FilteredItems = oFolder.items  ' @@@@@@@  to turn OFF filter   @@@@@@@@@
 
    Dim FilteredCount As Integer

    FilteredCount = FilteredItems.Count
    
    MsgBox FilteredCount

    ' if no unread, exit
    If FilteredCount = 0 Then GoTo Exit_Outlook_ExtractMessages    ' will run if you remove filter above @@@, for ALL

    '    For Each oItem In oFolder.items        ' NB I think goes through ALL in hte inbox, to find unread etc. so delelete old'ish from Imap
    For iFiltered = 1 To FilteredCount         '  FilteredItems.Count
        Set oItem = FilteredItems(iFiltered)    ' ######## ERROR - took some finding Array Out Of Bounds SEP 24 #############

        '        If oItem.UnRead = True Then
        With oItem
            If .Class = olMail Then
                AttCount = .Attachments.Count

                r.AddNew
                r!Subject = .Subject
                    
                r!Source = .HTMLBody
                PlainSource = PlainText(r!Source)
                r!surname = PickGR(PlainSource, "~s~")(1)  ' form textbox if pain so perhaps not needed but anway.
                
                r!MessageID = r!ID
                                        
                If NullOrEmpty(r!Email) Then r!Email = .senderEmailAddress
                    
                r!Received = .receivedTime
                r!Source = .HTMLBody
                  
                r!tToDo = True   ' Chilkat, on import form, top split form, default - was hard to find, not in code
    
SkipOldDates:  
                    

' REMOVED fair bit of code to fit in post, so perhaps messed up if/then etc.  may look wring but are OK
                    
                r.Update
                    
            End If
        End With
            
        '       End If
        oItem.UnRead = False   ' mark as read @@@@@@@@@@@ - Do want even with filtered
        
'        MsgBox iFiltered & " : just to slow down, pause really"
        
    Next iFiltered
 
    r.Close
    
Exit_Outlook_ExtractMessages:

    Set oOutlook = Nothing
    Set oNameSpace = Nothing
    Set oFolder = Nothing
    Set oItem = Nothing
    Set oPrp = Nothing
    
    Me.Requery
 '   MsgBox "done"
 
Error_Handler_Exit:
    On Error Resume Next
    If Not oPrp Is Nothing Then Set oPrp = Nothing
    If Not oItem Is Nothing Then Set oItem = Nothing
    If Not oFolder Is Nothing Then Set oFolder = Nothing
    If Not oNameSpace Is Nothing Then Set oNameSpace = Nothing
    If Not oOutlook Is Nothing Then Set oOutlook = Nothing
    Exit Sub
 
Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
        "Error Number: " & Err.Number & vbCrLf & _
        "Error Source: Outlook_ExtractMessages" & vbCrLf & _
        "Error Description: " & Err.DESCRIPTION & _
        Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
        , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub
 
I use this to remove duplicates.

Code:
Public Sub RemoveDupe()
    'Dim Session As Outlook.NameSpace
    Dim CurrentExplorer As Explorer
    Dim oSelection As Outlook.Selection
    Dim strSubject1 As String, strSubject2 As String
    Dim i As Long
   
    Dim obj As Object
   

    Set CurrentExplorer = Application.ActiveExplorer
    Set oSelection = CurrentExplorer.Selection
   
    'For Each obj In Selection

     'With obj

    ' do whatever
       'Debug.Print .Subject
    
     'End With

    'Next
    ' Options can be .Subject, .Size, .ReceivedTime
    strSubject1 = oSelection.item(1).Subject & oSelection.item(1).Size & oSelection.item(1).ReceivedTime
    For i = 2 To oSelection.Count
        strSubject2 = oSelection.item(i).Subject & oSelection.item(i).Size & oSelection.item(i).ReceivedTime
        Debug.Print "1 " & strSubject1
        Debug.Print "2 " & strSubject2
        If strSubject1 = strSubject2 Then
            oSelection.item(i).Delete
        Else
            strSubject1 = oSelection.item(i).Subject & oSelection.item(i).Size & oSelection.item(i).ReceivedTime
        End If
    Next i
   
    'Set Session = Nothing
    Set CurrentExplorer = Nothing
    Set obj = Nothing
    Set oSelection = Nothing

End Sub

and there is also this one where you just select a folder and not the selected items.
Code:
Sub RemoveDuplicateItems()
    Dim objFolder As Folder
    Dim objDictionary As Object
    Dim i As Long, lngCount As Long
    Dim objItem As Object
    Dim strKey As String

   
    Set objDictionary = CreateObject("scripting.dictionary")
    'Select a source folder
    Set objFolder = Outlook.Application.Session.PickFolder

    If Not (objFolder Is Nothing) Then
        ProgressBox.Show
        lngCount = objFolder.Items.Count
       For i = objFolder.Items.Count To 1 Step -1
           Set objItem = objFolder.Items.item(i)
 
           Select Case objFolder.DefaultItemType
                  'Check email subject, body and sent time
                  Case olMailItem
                        If Left(objItem.Subject, 4) <> "Read" And Left(objItem.Subject, 9) <> "Undeliver" Then
                            strKey = objItem.Subject & "," & objItem.ReceivedTime ' Body & "," & objItem.SentOn
                        End If
                  'Check appointment subject, start time, duration, location and body
                  Case olAppointmentItem
                       strKey = objItem.Subject & "," & objItem.Start & "," & objItem.Duration & "," & objItem.Location & "," & objItem.Body
                  'Check contact full name and email address
                  Case olContactItem
                       strKey = objItem.FullName & "," & objItem.Email1Address & "," & objItem.Email2Address & "," & objItem.Email3Address
                  'Check task subject, start date, due date and body
                  Case olTaskItem
                       strKey = objItem.Subject & "," & objItem.StartDate & "," & objItem.DueDate & "," & objItem.Body
           End Select
 
           strKey = Replace(strKey, ", ", Chr(32))
            'Debug.Print strKey
           'Remove the duplicate items
           If objDictionary.Exists(strKey) = True Then
              objItem.Delete
           Else
              objDictionary.Add strKey, True
           End If
           ProgressBox.Increment Int((lngCount - i) / lngCount * 100)
       Next i
       ProgressBox.Hide
    End If
    MsgBox "Duplicate Items removed"
End Sub
 
Last edited:
Many thanks for prompt reply,

That makes so much more sense than my way of thinking,

I was considering see if outlook would do it & add-ins but of course this is so much smarter.

I was not initially sure I could do this safely without comparison with the body of the email as clients re-send with v.small alterations immediately so thought could be the same, outlook only shows minutes but realize the date stamp is seconds so guess impossible to have the same subject & exactly the same time

Thanks again
 
They work for me, but debug it thoroughly with extra criteria if need be.
I added a second routine.
 
Last edited:
I think I will have to look a little deeper, I had mistakenly thought the time was exactly the same & so pure copy on the server, safe to delete.
Is stranger still as definitely when I have these, almost identical email it errors on loading, e.g. find 3 unread, reads the first 2, then nothing in the array for the 3rd, re-run again it comes in fine. I have a number of similar groups of emails like this so not a client pressing send,send,send & all do the same.

Size is few byes different, time 30 sec's ish different. Not shown here but the EntryID are different (of course), just a single digit out.

I will try to work out, if not a work around, I really not sure about matching the whole body email, can be rather long & rtf long text field.

Pogo 30 Sep 2024 - 15 Oct 2024 - CheckQuote 8958 31-08-2024 20:01:24
Pogo 30 Sep 2024 - 15 Oct 2024 - CheckQuote 8688 31-08-2024 20:01:58
Pogo 30 Sep 2024 - 15 Oct 2024 - CheckQuote 8672 31-08-2024 20:02:09

Thanks again
 
I would just be using debug.print until you are sure they are dupes.
I just ran the second block of code, which saves processing the whole folder and whilst they appeared dupes in outlook, the time was out by a few seconds, so it was not identified ad a dupe.
 
Last edited:
Hi,

Update on below.

if I do not set as read or move that email as I go, I do not get an error, "array out of bounds"
I guess to do with messing with the filtered list.

Odd it works 99%& of the time & only on specific emails, no identifing traits (& can be replicated) that it causes problems & apart from duplicate emails (the ID's are different) where always causes the error.

I think I have to review the code & rethink.

==============================================================================

Thanks for all your replies. In the end I found my wordpress www & contact forms was mostly to blame, suddenly started sending these duplicates, fixed that, still get a few but catch the errors which leads me to sort of a different issue, catching a few errors but no duplicates

The same original code at the top & on
Set oItem = FilteredItems(iFiltered) ' ######## ERROR - took some finding Array Out Of Bounds SEP 24 #############

I am wondering if its getting marked as read
oItem.UnRead = False ' mark as read @@@@@@@@@@@ - Do want even with filtered
& upsetting things.

This is code I have copied & found on a few places, I have commented to myself "Do want even with filtered" thinking I expected it to cause problems & I would have expected it to re-read those I have marked but as 99% fine & only errors on certain emails & can be repeated figured not however Is there a better way?

If I left as unmark, repeated the whole loop immediately after, marking those unread there would be a chance that a NEW unread email might get missed.

I like to use an unread filtered outlook list in the main inbox for my lists, I suppose the next best thing or sensible option would be to move those emails as read to a different subfolder. prefer what I a doing,

Have since also got it to move to a subfolder instead of marking as read, same results

Should my code work as is, and it is the server messing about or is the marking read poor programming.

any advise?

thanks I/A
 
Last edited:

Users who are viewing this thread

Back
Top Bottom