Moving Emails in Outlook Folders to Subfolder with VBA according to Datasets in Excel

Question

I found A question addresing this concern similar to mine here;

How can I move Mails Items from Outlook Inbox with specific subject to specific folder/sub folder?

The first Module- The first part of this code- i have exported all email data to the spreadsheet successfully.

The Second Module- I would like to instruct Excel VBA to Move Emails in the main Folder to a subfolder based on datasets i typed out in the spreadsheet ( it will not be based on a filter/Criteria of the emails itself,just its unique subject tittle).

In Column (c), is the subject of the email (All of the subject tittles are specific/unique) and in column (h), i have detailed the name of the sub-folder where i would like to have it moved too. Unfortunately, i have an error while executing the code i created.

I am a beginner in Excel VBA and dont have the best understanding.I got an idea of my code based on different sources, if its incorrect do let me know, it will be greatly appreciated

Thank you.

• i Tried executing the code i found in the questioned asked by the user similar to mine, however it didnt work

Sub MovingEmails_Invoices()

  'Declare your Variables
    Dim items As Outlook.items
    Dim subfolder As Outlook.Folder 'this will be the folder you want to move the Mail to

    'Set Outlook Inbox Reference
    Set OP = New Outlook.Application
    Set NS = OP.GetNamespace("MAPI")
    Set Mail = OP.CreateItem(olMailItem)

    'To loop through subfolder and its folders
    Set rootfol = NS.Folders("SYNTHES-JNJCZ-GBS.DE.AT.CH@ITS.JNJ.com")
    Set Folder = rootfol.Folders("Austria")


'The list for invoice number should be dynamic
Dim arraysearch(1 To 1000) As String
Dim i As Long
i = UBound(arraysearch)
arraysearch(i) = Range("C2").offset(i, 0).Value
If i = 0 Then
MsgBox "error"
Exit Sub
End If


'The list for folder type should be dynamic
Dim arraymove(1 To 1000) As String
i = UBound(arraymove)
arraymove(i) = Range("H2").offset(i, 0).Value
If i = 0 Then
MsgBox "error"
Exit Sub
End If

'specific folders for the mail to move to
Set subfolder = rootfol.Folders(arraymove(i))


For Each Mail In Folder.items.Restrict("[Subject] >= arraysearch(i)")

   If arraysearch(i) = arraymove(i) Then

   item.Move subfolder

   End If

   Next Mail

End Sub

Answer 1

In the code you are iterating over all items in the folder:

  'Loop through the Items in the folder backwards
     'Setting Mail to counting backwards
    For lngCount = items.Count To 1 Step -1
    'setting object as Email item
        Set item = items.item(lngCount)

This is really not a good idea. Especially if you later use the Find method.

If you need to find items that correspond to your conditions I'd suggest using the Find/FindNext or Restrict methods of the Items class. Read more about these methods in the following articles:

• 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

Also, you may find the AdvancedSearch method of the Application class helpful. 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). You can read more about this in the Filtering article in MSDN. 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.

Answer 2

There is no need to try to find the item.

It is already identified with Set item = items.item(lngCount).

You can check the subject to see if it is the item you want.

'Find Email using Subject found on Column C
'Set item = items.Find(FilterText)

'If the object is an Email
If item.Class = olMail Then

    If item.Subject = FilterText Then 

        'Find item under the main Folder subfolders
        Set subfolder = Folder.Folders(FolderMove)

        'Mark Item as Read
        item.UnRead = False

        'Move Item to folder type in Outlook
        item.Move subfolder
    End If

End If