Microsoft Outlook email

Outlook Banter (http://www.outlookbanter.com/)

- Outlook and VBA (http://www.outlookbanter.com/outlook-vba/)

- - How to (http://www.outlookbanter.com/outlook-vba/84302-how.html)

I have some VBA code that saves attachments from a message. The process
works great. What I want to do is though is to tell it to perform this
action on the message just received.

Currently, there is a rule that sends any message that fits the criteria to
a folder and then runs the script below, which in turn calls the sub for the
attachements.
When the SaveAttachment sub runs, it runs on whatever message was last
selected, not the message that just came in. How do I point the code to the
message that just came in?

Code:

Sub SaveAtt(MyMail As MailItem)

SaveAttachment

End Sub

Sub SaveAttachment()

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

'Ask for destination folder
myOrt = "Q:\Finance\PJ\"

'On Error Resume Next

'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

'for all items do...
For Each myItem In myOlSel

'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

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

Thanks!
PJ

You can create a rule for incoming messages, which calls the SaveAtt method.
The rule passes the incoming message to the MyMail variable, so probably
that's the object you want to work with. But right now you perfom the
actions on every selected e-mail by iterating through the Selection object
(as the code comments also tell you).

--
Best regards
Michael Bauer - MVP Outlook

: Outlook Categories? Category Manager Is Your Tool
: VBOffice Reporter for Data Analysis & Reporting
: http://www.vboffice.net/product.html?pub=6&lang=en

Am Fri, 9 Jan 2009 13:52:43 -0800 schrieb PJFry:

I have some VBA code that saves attachments from a message. The process
works great. What I want to do is though is to tell it to perform this
action on the message just received.

Currently, there is a rule that sends any message that fits the criteria
to
a folder and then runs the script below, which in turn calls the sub for
the
attachements.
When the SaveAttachment sub runs, it runs on whatever message was last
selected, not the message that just came in. How do I point the code to
the
message that just came in?

Code:

Sub SaveAtt(MyMail As MailItem)

SaveAttachment

End Sub

Sub SaveAttachment()

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

'Ask for destination folder
myOrt = "Q:\Finance\PJ\"

'On Error Resume Next

'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

'for all items do...
For Each myItem In myOlSel

'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

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

Thanks!
PJ

Michael,

That did the trick.

Thanks!

PJ

"Michael Bauer [MVP - Outlook]" wrote:

You can create a rule for incoming messages, which calls the SaveAtt method.
The rule passes the incoming message to the MyMail variable, so probably
that's the object you want to work with. But right now you perfom the
actions on every selected e-mail by iterating through the Selection object
(as the code comments also tell you).

--
Best regards
Michael Bauer - MVP Outlook

: Outlook Categories? Category Manager Is Your Tool
: VBOffice Reporter for Data Analysis & Reporting
: http://www.vboffice.net/product.html?pub=6&lang=en

Am Fri, 9 Jan 2009 13:52:43 -0800 schrieb PJFry:

I have some VBA code that saves attachments from a message. The process
works great. What I want to do is though is to tell it to perform this
action on the message just received.

Currently, there is a rule that sends any message that fits the criteria
to
a folder and then runs the script below, which in turn calls the sub for
the
attachements.
When the SaveAttachment sub runs, it runs on whatever message was last
selected, not the message that just came in. How do I point the code to
the
message that just came in?

Code:

Sub SaveAtt(MyMail As MailItem)

SaveAttachment

End Sub

Sub SaveAttachment()

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

'Ask for destination folder
myOrt = "Q:\Finance\PJ\"

'On Error Resume Next

'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

'for all items do...
For Each myItem In myOlSel

'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

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

Thanks!
PJ