CODEWITHSUNDEEP
vbaoutlook
Max Mustermensch
Max Mustermensch

Reputation: 11

Identify oldest date of unread emails in a folder, including subfolders

I have a mailbox with the name "Mailboxname"

My target: To count all unread emails within the folders of the 3rd level including its subfolders AND to identify the oldest date of the unread emails within each folder of 3rd level including its subfolders.

The results should looks like:

and so on.

The following VBA code counts the unread emails correctly.

The oldest date is not correct.
The oldest date is indicated only within folders of the 4th level. For example within subfolders of "Folder1". The dates from "Folder1" are not considered.

Sub CountUnreadEmailsInFolders3rdLeve()
    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim intUnreadCount As Integer
    Dim folders3rdLevel As Variant
    Dim i As Integer
    Dim j As Integer
    Dim results() As String
    Dim folderResults() As Integer
    Dim oldestDate As Date
    Dim folderResultIndex As Integer
    
    ' Define the array of 3rd level folders
    folders3rdLevel = Array("Folder1", "Folder2", "Folder3", "Folder4", "Folder5")
    
    ' Get the Outlook namespace object
    Set objNS = Application.GetNamespace("MAPI")
    
    ' Initialize the results arrays
    ReDim results(UBound(folders3rdLevel))
    ReDim folderResults(UBound(folders3rdLevel))
    folderResultIndex = 0
    
    ' Loop through the 3rd level folders
    For i = 0 To UBound(folders3rdLevel)
        ' Get the mailbox folder
        Set objFolder = objNS.Folders("Mailboxname").Folders("Inbox").Folders("Workemails").Folders(folders3rdLevel(i))
        
        ' Reset the folder results counter and oldest date
        folderResults(i) = 0
        oldestDate = Now
        
        ' Count unread emails in the folder
        intUnreadCount = objFolder.items.Restrict("[UnRead] = true").count
        folderResults(i) = folderResults(i) + intUnreadCount
        
        ' Loop through the subfolders of the folder
        For j = 1 To objFolder.Folders.count
            ' Count unread emails in the subfolder
            intUnreadCount = objFolder.Folders(j).items.Restrict("[UnRead] = true").count
            folderResults(i) = folderResults(i) + intUnreadCount
            
            ' Determine the oldest date of the unread emails within the subfolder
            If intUnreadCount > 0 Then
                Dim objMail As Object
                Set objMail = objFolder.Folders(j).items.Restrict("[UnRead] = true").GetFirst()
                Do While Not objMail Is Nothing
                    If TypeOf objMail Is Outlook.mailItem Then
                        If objMail.ReceivedTime < oldestDate Then
                            oldestDate = objMail.ReceivedTime
                        End If
                    End If
                    Set objMail = objFolder.Folders(j).items.Restrict("[UnRead] = true AND [ReceivedTime] < '" & Format(oldestDate, "ddddd h:nn AMPM") & "'").GetNext()
                Loop
            End If
        Next j
        
        ' Store the result in the results array
        results(folderResultIndex) = objFolder.Name & ": " & folderResults(i) & " unread emails, oldest email received on " & IIf(IsDate(oldestDate), Format(oldestDate, "dd/mm/yyyy hh:mm:ss"), "N/A") & vbCrLf
        folderResultIndex = folderResultIndex + 1
    Next i
    
    ' Display the results in a message box
    MsgBox Join(results, vbNewLine)
    
    ' Save results to a text file in the specified directory
    Dim filePath As String
    Dim fileName As String
    filePath = "C:\Work_Data\Statistic\"
    fileName = Format(Date, "yyyymmdd") & "_Statistic.txt"
    
    Open filePath & fileName For Output As #1
    Print #1, Join(results, vbNewLine)
    Close #1
End Sub

Upvotes: 0

Views: 163

Answers (1)

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66316

You keep resetting the oldestDate variable - set it to Now only once at the very beginning, and then set it only if the newest value is older.

Another problem is that you keep retrieving the restricted items list - every time you call Restrict (or Items etc. for that matter), you get a new Items collection with no knowledge of any previous instances. You need to work with the same object:

set Items = objFolder.Folders(j).items.Restrict("[UnRead] = true")
Set objMail = Items.GetFirst()
Do While Not objMail Is Nothing
    ...
    Set objMail = Items.GetNext()
Loop

Also, there is no reason to loop through all unread items returned by Restrict - just Sort the collection and retrieve the first item:

set Items = objFolder.Folders(j).items.Restrict("[UnRead] = true")
if Items.Count > 0 Then
  Items.Sort("[ReceivedTime]", false)   
  Set objMail = Items(1)
  If objMail.ReceivedTime < oldestDate Then
    oldestDate = objMail.ReceivedTime
  End If
End If

Upvotes: 0

Related Questions