Hi all -

I am attempting to filter email inbox for incoming message with WOR
anywhere in the subject line.
If find WOR anywhere on the subject line, save the attachment to
specified location, remove the attachment, place text in body of e-mail
with message where file was saved to, move msg to .pst folder.

My code below cobbled together with a post I found at Outlookcode.com
and a post here.
No errors are raised (error handler) But the code does not give any
attachments to the specified folder

Can anyone point out what I did wrong?
Thanks
-goss

Sub SaveAttachment()
'Code via Outlookcode.com
'Filter bit via Dave Quaid Google Groups
'http://tinyurl.com/grv2y


'Declaration
Dim myItems, myItem, myAttachments, myAttachment, cdoFolder As
Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim myOlItems As Outlook.Items

'Destination folder
'Change the destination as needed
myOrt = "C:\Data\Reports\WORS"

On Error Resume Next

'work on selected items
cdoFolder = cdoMapiSession.GetDefaultFolder(cdoFolderID)
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
Set myOlItems = cdoFolder.messages.Filter.Subject

'for all items do...
For Each myItem In myOlSel
If InStr(myOlItems, "WOR") Then

'point on attachments
Set myAttachments = myItem.Attachments

'if there are some...
If myAttachments.Count 0 Then

'add remark to message text
myItem.Body = myItem.Body & vbCrLf & _
"Removed Attachments:" & vbCrLf

'for all attachments do...
For i = 1 To myAttachments.Count

'save them to destination
myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName

'add name and destination to message text
myItem.Body = myItem.Body & _
"File: " & myOrt & _
myAttachments(i).DisplayName & vbCrLf

Next i

'for all attachments do...
While myAttachments.Count 0

'remove it (use this method in Outlook XP)
'myAttachments.Remove 1

'remove it (use this method in Outlook 2000)
myAttachments(1).Delete

Wend

'save item without attachments
myItem.Save
End If
End If
Next

'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing

End Sub