Public Sub MoveSelectedMessages()
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objDestFolder As Outlook.MAPIFolder
Dim objSourceFolder As Outlook.Folder
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim obj As Object
Dim objVariant As Variant
Dim lngMovedItems As Long
Dim intCount As Integer
Dim intDateDiff As Integer
Dim strDestFolder As String
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set currentExplorer = objOutlook.ActiveExplorer
Set Selection = currentExplorer.Selection
Set objSourceFolder = currentExplorer.CurrentFolder
'Dim arrAddress As Variant
' Set up the array
'' arrAddress = Array("address1", "address2", "address3", "address4", "address5", "address6", "address7", "address8", "address9")
' array from list
Dim fn As String, ff As Integer, txt As String
fn = "C:\Users\diane\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
Debug.Print txt
Dim arrAddress() As String
'Use Split function to return a zero based one dimensional array.
arrAddress = Split(txt, vbCrLf)
''' end arrray
For Each obj In Selection
Set objVariant = obj
If objVariant.Class = olMail Then
Dim Recipients As Recipients
Set Recipients = objVariant.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)
strDomain = ""
' Use semicolon separator if there is more than 1 address
If i = 1 Then
strDomain = recip
Else
strDomain = strDomain & recip & "; "
End If
Next i
Debug.Print strDomain
' Go through the array and look for a match, then do something
For i = LBound(arrAddress) To UBound(arrAddress)
If InStr(LCase(strDomain), arrAddress(i)) > 0 Then
On Error Resume Next
Set objDestFolder = objNamespace.GetDefaultFolder(olFolderInbox).Parent.Folders("Unwanted")
objVariant.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 currentExplorer = Nothing
Set obj = Nothing
Set Selection = Nothing
Set objOutlook = Nothing
Set objNamespace = Nothing
Set objSourceFolder = Nothing
End Sub