How move email to another Folder if contains “x” word in subject or body, etc?

[Su_80]

Hello,

I'm trying to learn use VBA with Outlook. Simple things in the first place.




I need to adapt this code. I don't get replace "=" by "contains":

("[Subject] = 'alert'")

Doesn't work typing "*" before or an after.
Also I want to add something more... I want moving the email to another Folder names (WORK) If it's contains the "alert" word in the subject OR if contains "check" word in the body...

someone helping me?


Thanks in advance.


Sub MoveItems()
Dim myNameSpace As Outlook.NameSpace
Dim myinbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myItems As Outlook.Items
Dim myItem As Object


Set myNameSpace = Application.GetNamespace("MAPI")
Set myinbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myinbox.Items
Set myDestFolder = myinbox.Folders("WORK")
Set myItem = myItems.Find("[Subject] = 'alert'")


While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend

End Sub

[gmayor]

The following will do what you ask, but I suspect that what you asked is not what you want. Looking for 'check' in the body of the text is a rather blunt instrument. I suspect that you are looking for the work in context with a payment, but you will also get unrelated instances of that string e.g. 'check-up' and 'checking' and unrelated uses of the work check alone . I suggest you search for text more specific to your actual requirement



Sub MoveItems()
Dim myNameSpace As Outlook.NameSpace
Dim myinbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myItems As Outlook.items
Dim myItem As Object
Dim lCount As Long


Set myNameSpace = Application.GetNamespace("MAPI")
Set myinbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myinbox.items
Set myDestFolder = myinbox.folders("WORK")
For lCount = myItems.Count To 1 Step -1 'Search backwards if removing items to maintain the count
Set myItem = myItems(lCount)
With myItem
If InStr(1, .Subject, "'alert'") > 0 Or _
InStr(1, .Body, "check") > 0 Then
myItem.Move myDestFolder
End If
End With
Next lCount
MsgBox "Process complete", vbInformation
Set myNameSpace = Nothing
Set myinbox = Nothing
Set myDestFolder = Nothing
Set myItems = Nothing
Set myItem = Nothing
End Sub

[Su_80]

Hello, I managed to adapt it without problems. Thank you so much!!