Save attachment with filter by subject

G

goss9394

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
 
S

Sue Mosher [MVP-Outlook]

You won't see any errors unless you comment out the On Error Resume Next statement.

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
 
G

goss9394

OK
Error handler commented out
Error is "Object required"

Debug points to this line
cdoFolder = cdoMapiSession.GetDefaultFolder(cdoFolderID)

I did Dim the cdoFolder as object
Dim myItems, myItem, myAttachments, myAttachment, cdoFolder As
Object

What did I miss?
Thanks
-goss
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top