Run VBA script on email matching Outlook Rule

[dababler]

As it is not clear how your folders and accounts are arranged who not simply pick the destination folder also

Set olFolder = Application.Session.PickFolder
Set olDestFolder = Application.Session.PickFolder

Or you can Loop throughout the stores and select the store name which is the partially obscured 'dbable' etc then loop through the folders there

Sub Test()
Dim olStore As Store
Dim olDestFolder As Folder
    For Each olStore In Application.Session.Stores
        If olStore.DisplayName = "dbable...etc" Then
            For Each olDestFolder In olStore.GetRootFolder.folders
                If olDestFolder.Name = "Test" Then
                    MsgBox olDestFolder.Items.Count
                    Exit For
                End If
            Next olDestFolder
            Exit For
        End If
    Next olStore
End Sub

Or if you are certain of the path of 'Test' which appears to be a direct sub folder of 'dbable...etc' then you can select it directly

Sub Test2()
Dim olDestFolder As Folder
    Set olDestFolder = Application.Session.Stores("dbable... etc").GetRootFolder.folders("Test")
    MsgBox olDestFolder.Items.Count
End Sub

All of those worked great thank you!



I do have another question if you don't mind.

I modified it to search through an Array; but I keep getting Run-Time error, the message you specified cannot be found.

Sub MoveMessages()Dim olFolder As Folder
Dim olDestFolder As Folder
Dim olItems As Outlook.Items
Dim t As Long, j As Long: j = 0
Dim arrTest As Variant
arrTest = Array("spring", "reaching out", "reviewing the data")


 Set olFolder = Application.Session.Stores("dbable***x").GetRootFolder.Folders("Production")
    Set olDestFolder = Application.Session.Stores("dbabler******").GetRootFolder.Folders("Test")
    Set olItems = olFolder.Items
    For t = olItems.Count To 1 Step -1
        If TypeName(olItems(t)) = "MailItem" Then
            For b = LBound(arrTest) To UBound(arrTest)
                  If InStr(olItems(t).Body, arrTest(b)) Then
                    olItems(t).Move olDestFolder
                    j = j + 1
                    Else
                              
                End If
            Next b
        End If
    Next t
    MsgBox j & " message items moved"
lbl_Exit:
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olDestFolder = Nothing
    Exit Sub
End Sub

It will move a couple of messages then fail. What am I doing wrong?


Is it because I'm searching the body?
or is it because I am doing something wrong with my array...?
Here is a picture of my local window if that is helpful.

local info.jpg

Thank you again in advance for your help, and for your past help