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

With the cursor in the code, F8 until the error occurs. Edit the question to identify that line. — niton, Aug 01 '19 at 12:00
The new code you added today doesn't make any sense. You create an array with 1000 dimensions and then you only assign a value on one of the thousand dimensions. It's hard to tell what you expect this to do. I think you're missing a loop for your iterator "i". — HackSlash, Aug 12 '19 at 16:07

score 1 · Answer 1 · answered Aug 04 '19 at 11:54

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:

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.

Hi thank you so much for your suggestion, i did look into both of these options, restrict and even DASL quries, but for my code i used restrict method. I rewrote my code now and im using arrays as additional step to make it more concise. My struggle is to match the 'subject' of the email to the folder type iy needs to move too. By any chance, could you please assist me. There was an error with my new code as well, debug showed me for this code ; `set subfolder =rootfol.folders(arraymove(i)) ` — Santya, Aug 12 '19 at 15:10

score 0 · Answer 2 · answered Aug 01 '19 at 14:54

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

Hi niton! thank you for your comment now i decided that the whole find method might not be the best way to perform this function. So i rewrote it and decided to use arrays. Unfortunately there is still an error for my new code at; `Set subfolder = rootfol.Folders(arraymove(i))` if you have any advice do it better, i would really appreciate it thank you! — Santya, Aug 12 '19 at 15:18

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

2 Answers2