VBA CODE Help? or point me in the right direction.

[GaryG9595]

Hello,
Does anyone know of a way to move emails (outlook) from one subfolder to another based on a list from excel?
Similar to a rule, but instead of adding the specific words/numbers one at a time, can I use a list from excel?
Basically, I have a list of completed items in Column R in excel and would like to find the "20531" in the subject line of my outlook folder "Update Contact Info"and if it's there, move it to another folder called "Completed" and leave the remaining emails.
Thanks,
Gary

 

[Colo]

Hi Gary,
Give this sample code a try. I assume both folders are created under the Inbox.

Sub GetOutlookReceivedEmail()
    Const olFolderInbox As Long = 6
    Dim OutlookApp As Object, myNamespace As Object
    Dim oFromFolder As Object, oToFolder As Object
    Const startRow As Long = 5    'Data starting row in Column R
    Dim LastRow As Long
    Dim sTitle As String
    Dim Ret As Variant
    Dim i As Long

    'Set Outlook instance and NameSpace
    Set OutlookApp = CreateObject("Outlook.Application")
    Set myNamespace = OutlookApp.GetNamespace("MAPI")

    'Set Target Folders (Assume these are placed under "inbox")
    Set oFromFolder = myNamespace.GetDefaultFolder(olFolderInbox).Folders.Item("Update Contact Info")
    Set oToFolder = myNamespace.GetDefaultFolder(olFolderInbox).Folders.Item("Completed")

    'Looping for checking and moving items

    LastRow = Cells(Rows.Count, "R").End(xlUp).Row
    For i = oFromFolder.Items.Count To 1 Step -1
        sTitle = oFromFolder.Items.Item(i).Subject 'Title of email
        'Check if it's exist in the list in Column R
        Ret = Application.Match(sTitle, Cells(startRow, "R").Resize(LastRow - startRow + 1).Value, 0)
        'If Exist, move it.
        If Not IsError(Ret) Then oFromFolder.Items.Item(i).Move oToFolder
    Next
    MsgBox "Done"
End Sub