Looping through Arrays with VBA, to Move outlook emails from one folder to another?

问题

I want to move emails of invoices from a main folder to a different folder.

I extracted the subject of the emails with VBA from outlook in the first module, they are in column 3. Then I manually write out the folder I would like the emails to move to, in column 8. (The names of the folder is a subfolder)

Column 3 is the subject of the email which I extracted, I used the restrict method for outlook to return the email with the specific tittle

Column 8 is the folder I would like the email to move too.

Example is like below The code has to place email in the main folder with subject'A' to Folder '1'

Column 3      columnn 8

A                 1
B                 2
C                 2
D                 1
E                 1

The reason I use arrays is because, every time I make an extract, the list changes, hence it is dynamic. Therefore, I used LBound and UBound to include the whole list of invoices.

I have declared all variables here in the first module as 'public'. Only left the relevant ones here to the code

Sub MovingEmails_Invoices()

  'Declare your Variables
    Dim i As Object
    Dim myitems As Object
    Dim subfolder As Outlook.Folder 


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

    '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 numbers and folders is dynamic
'Each subject being searched is different

Dim Listmails() As Variant
Dim Rowcount As Long
Dim Mailsubject As Variant
Dim FolderName As Variant
Dim MS As String
Dim myrestrictitem As Outlook.items

 'Establish the array based on the mailbox extract
  Sheets("files").Activate
  Listmails = Range("A2").CurrentRegion


'Ititerate through the array which is dynamic (One-dimensional)
For Rowcount = LBound(Listmails) To UBound(Listmails)

'3rd row for email subject 'used DASL Filter
Mailsubject = Application.WorksheetFunction.Index(Listmails, Rowcount, 3)
MS = "urn:schemas:mailheader:subject LIKE \'%" & Mailsubject & "%\'"

    'Find the email based on the array for email subject
    Set myitems = Folder.items
    Set myrestrictitem = myitems.Restrict(MS)

        For each i in myrestrictitem
        If i.class = olmail then

         '8th row for folder name
         FolderName = Application.WorksheetFunction.Index(Listmails, Rowcount,8) 
         Set subfolder = rootfol.Folders(FolderName) ' i have an error here

         'If email found then mark it as read
         i.UnRead = False

         'Move it to the subfolder based on the array for folder name
         i.Move subfolder

Next Rowcount

End Sub

Now, I used the example I got from Microsoft Office Center to construct the restrict part, the last example on this page: https://docs.microsoft.com/en-us/office/vba/api/outlook.items.restrict

when I try to do the same way, it doesn't work for my code.

The error message comes from;

Set myrestrictitem = myitems.Restrict(MS)

and ?

Set subfolder = rootfol.Folders(FolderName)

The error message is the condition is not correct. Also it could be because I am doing the loop incorrectly.

Could there be another way of doing this, without arrays maybe? do i need IF condition?

回答1:

You condition must include the @SQL= prefix. It is also a good idea to double quote the DASL property names:

@SQL="urn:schemas:mailheader:subject" LIKE '%test%'

You also should not use "for each" when you are changing the collection (by calling Move). Use a down loop:

for i = myrestrictitem.Count to 1 step -1
  set item =  myrestrictitem.Item(i)
  ..
  item.Move subfolder

来源：https://stackoverflow.com/questions/57591174/looping-through-arrays-with-vba-to-move-outlook-emails-from-one-folder-to-anoth

标签

excel

vba

outlook

outlook-vba