Public Sub MoveSelectedMessages() Dim objOutlook As Outlook.Application Dim objNamespace As Outlook.NameSpace Dim objDestFolder As Outlook.MAPIFolder Dim objSourceFolder As Outlook.Folder Dim obj As Object Dim lngMovedItems As Long Dim intCount As Integer Dim strAddress As String Set objOutlook = Application Set objNamespace = objOutlook.GetNamespace("MAPI") Set objSourceFolder = objOutlook.ActiveExplorer.CurrentFolder Set objDestFolder = objNamespace.GetDefaultFolder(olFolderInbox).Parent.Folders("Unwanted") ' array from list Dim fn As String, ff As Integer, txt As String fn = "D:\Documents\addresses-to-move.txt" '< --- .txt file path txt = Space(FileLen(fn)) ff = FreeFile Open fn For Binary As #ff Get #ff, , txt Close #ff Dim arrAddress() As String 'Use Split function to return a zero based one dimensional array. arrAddress = Split(txt, vbCrLf) ' end arrray For intCount = objSourceFolder.Items.count To 1 Step -1 Set obj = objSourceFolder.Items.Item(intCount) Debug.Print objSourceFolder.Items.count If obj.Class = olMail Then Dim Recipients As Recipients Set Recipients = obj.Recipients For i = Recipients.count To 1 Step -1 recip$ = Recipients.Item(i).Address ' To use only the alias from the x.500 address ' If InStr(1, LCase(recip), "/ou=") Then recip = Right(recip, Len(recip) - InStr(1, LCase(recip), "recipients") - 13) ' clear the string for the next message strAddress = "" ' Use semicolon separator if there is more than 1 address If i = 1 Then strAddress = recip Else strAddress = strAddress & recip & "; " End If Next i Debug.Print strAddress ' Go through the array and look for a match, then do something For i = LBound(arrAddress) To UBound(arrAddress) If InStr(LCase(strAddress), arrAddress(i)) > 0 Then On Error Resume Next obj.Move objDestFolder 'count the # of items moved lngMovedItems = lngMovedItems + 1 GoTo NextMsg End If Next i NextMsg: End If Next ' Display the number of items that were moved. MsgBox "Moved " & lngMovedItems & " messages(s)." Set obj = Nothing Set objOutlook = Nothing Set objNamespace = Nothing Set objSourceFolder = Nothing End Sub