Extract outlook data from multiple emails address or subfolders

Question

I have the below code that extract data from outlook folder and select date range or limit date. However, I am trying to extract data from "multiple outlook folders", but the below code only allow me to select from "1" folder at a time.
How can I possibly select more folders or loop this to add more data from other folder? please help! I have searched everywhere and unable to find solution.


Sub getDataFromOutlookChoiceFolder()

Dim OutlookApp As Outlook.Application
Dim OutlookNameSpace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Long

Set OutlookApp = New Outlook.Application
Set OutlookNameSpace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNameSpace.PickFolder

If Folder.Items.Count = 0 Then
MsgBox "No emails. Existing procedure!"
Exit Sub
End If

i = 1

Dim rngName As Name
Sheet1.Cells.Clear
For Each rngName In ActiveWorkbook.Names
rngName.Delete
Next

Range("A1").Name = "receivedtime"
Range("A1") = "Received Time"
Range("B1").Name = "From"
Range("B1") = "From"
Range("C1").Name = "To"
Range("C1") = "To"
Range("D1").Name = "Subject"
Range("D1") = "Subject"
Range("E1").Name = "Body"
Range("E1") = "Body"
Range("F1").Name = "Conversation_ID"
Range("F1") = "Conversation ID"
Range("G1").Name = "email_Receipt_Date"
Range("G2").Name = "email_end_date"
Range("email_Receipt_Date").Value = InputBox("Enter Receipt Date like DD-Mon-YYYY")
Range("email_end_date").Value = InputBox("Enter Receipt Date like DD-Mon-YYYY")

    
For Each OutlookMail In Folder.Items
If OutlookMail.ReceivedTime >= Range("email_Receipt_Date").Value And OutlookMail.ReceivedTime <= Range("email_end_date").Value Then


Range("receivedtime").Offset(i, 0).Value = OutlookMail.ReceivedTime
Range("receivedtime").Offset(i, 0).Columns.AutoFit
Range("receivedtime").Offset(i, 0).VerticalAlignment = xlTop
Range("from").Offset(i, 0).Value = OutlookMail.SenderName
Range("from").Offset(i, 0).Columns.AutoFit
Range("from").Offset(i, 0).VerticalAlignment = xlTop
Range("to").Offset(i, 0).Value = OutlookMail.To
Range("to").Offset(i, 0).Columns.AutoFit
Range("to").Offset(i, 0).VerticalAlignment = xlTop
Range("subject").Offset(i, 0).Value = OutlookMail.Subject
Range("subject").Offset(i, 0).Columns.AutoFit
Range("subject").Offset(i, 0).VerticalAlignment = xlTop
Range("body").Offset(i, 0).Value = OutlookMail.Body
Range("body").Offset(i, 0).Columns.AutoFit
Range("body").Offset(i, 0).VerticalAlignment = xlTop
Range("Conversation_ID").Offset(i, 0).Value = OutlookMail.ConversationID
Range("Conversation_ID").Offset(i, 0).Columns.AutoFit
Range("Conversation_ID").Offset(i, 0).VerticalAlignment = xlTop


i = i + 1
End If
Next OutlookMail

Set Folder = Nothing
Set OutlookNameSpace = Nothing
Set OutlookApp = Nothing


MsgBox ("Completed")
End Sub

score 1 · Answer 1 · answered Jun 11 '23 at 13:07

First of all, iterating through all items in the loop to get items for a specific date is not correct. Instead, you need to use the Find/FindNext or Restrict methods of the Items class. You can read more about these methods in the articles that I wrote for the technical blog:

How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder

If you need to process all subfolders you must iterate over subfolder recursively. For example:

Private Sub processFolder(ByVal oParent As Outlook.MAPIFolder)

   Dim oFolder As Outlook.MAPIFolder
   Dim oMail As Outlook.MailItem

   For Each oMail In oParent.Items
     'Get your data here ...
   Next

   If (oParent.Folders.Count > 0) Then
     For Each oFolder In oParent.Folders
        processFolder oFolder
     Next
   End If
End Sub

But a better yet solution which suits all your needs is the AdvancedSearch method of the Application class. The key benefits of using the AdvancedSearch method in Outlook are:

The search is performed in another thread. You don’t need to run another thread manually since the AdvancedSearch method runs it automatically in the background.
Possibility to search for any item types: mail, appointment, calendar, notes etc. in any location, i.e. beyond the scope of a certain folder. The Restrict and Find/FindNext methods can be applied to a particular Items collection (see the Items property of the Folder class in Outlook).
Full support for DASL queries (custom properties can be used for searching too). To improve the search performance, Instant Search keywords can be used if Instant Search is enabled for the store (see the IsInstantSearchEnabled property of the Store class).
You can stop the search process at any moment using the Stop method of the Search class.

Read more about that in the Advanced search in Outlook programmatically: C#, VB.NET article.

RichardCook · Answer 2 · 2023-06-11T12:37:22.073

Edit

Initialize the counter i before the loop. I'd left it where it was originally by mistake.

Original

It's easier than you realize. I've put your code in a Do ... Loop to allow the user to continue choosing folders until the user clicks Cancel. That exits the loop.

I removed most of your reporting lines just to keep this clean. Add them back in once you're convinced this works.

Option Explicit  ' Should be the first line in every module

Sub getDataFromOutlookChoiceFolder()
    Dim OutlookApp As Outlook.Application
    Dim OutlookNameSpace As Namespace
    Dim Folder As MAPIFolder
    Dim OutlookMail As Variant
    Dim i As Long
    Dim rngName As Name
    Dim wkshSheet1 As Worksheet  ' Dim this variable; Option Explicit will force that
    
    Set OutlookApp = New Outlook.Application
    Set OutlookNameSpace = OutlookApp.GetNamespace("MAPI")
    
    Set wkshSheet1 = ActiveWorkbook.Worksheets("Sheet1") ' Define for your needs
    wkshSheet1.Cells.Clear
    For Each rngName In ActiveWorkbook.Names
        rngName.Delete
    Next

    ' Shortened from original to save space; replace your original lines here
    Range("A1").Name = "receivedtime"
    Range("A1") = "Received Time"
    Range("B1").Name = "From"
    Range("B1") = "From"

    i = 1  ' EDIT: initialize i before loop

    ' Loop allowing user to choose folders
    Do
        Set Folder = OutlookNameSpace.PickFolder
        
        If Folder Is Nothing Then ' User clicked Cancel, bail out
            Exit Do
        End If
        
        ' Empty folder selected; (commented to allow loop to continue)
        If Folder.Items.Count = 0 Then
'            MsgBox "No emails. Exiting procedure!"
'            Exit Sub
        End If
        
'        i = 1  ' EDIT: MOVE THIS BEFORE LOOP
        
        For Each OutlookMail In Folder.Items
            If OutlookMail.ReceivedTime >= Range("email_Receipt_Date").Value And _
                    OutlookMail.ReceivedTime <= Range("email_end_date").Value Then
                
                Range("receivedtime").Offset(i, 0).Value = OutlookMail.ReceivedTime
                Range("receivedtime").Offset(i, 0).Columns.AutoFit
                Range("receivedtime").Offset(i, 0).VerticalAlignment = xlTop
                Range("from").Offset(i, 0).Value = OutlookMail.SenderName
                Range("from").Offset(i, 0).Columns.AutoFit
                Range("from").Offset(i, 0).VerticalAlignment = xlTop
                
                i = i + 1
            End If
        Next OutlookMail
        
    Loop  ' Choose next folder
    
    Set Folder = Nothing
    Set OutlookNameSpace = Nothing
    Set OutlookApp = Nothing
    
    MsgBox ("Completed")
End Sub

Thank you for this! I think I am missing something. The loop is working, but the data transferring into the worksheet is only from the last selected folder before cancelling. not all clicked folders — jrpdjb, Jun 11 '23 at 03:47

Extract outlook data from multiple emails address or subfolders

2 Answers2

Edit

Original