Don't loop through the Explorer.Selection, but use the Item object that is
passed as an argument. Then edt the rule to call the script only if the
e-mail comes from the particular sender.

And, please, delete the
Dim myOlApp As New Outlook.Application
line.

As Outlook already runs your code you must not try to create a new instance
of it. Then replace 'myOlApp' simply by 'Application'.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
Keep your Outlook categories organized!
http://www.shareit.com/product.html?...4&languageid=1
(German: http://www.VBOffice.net/product.html?pub=6)


Am Fri, 19 Jan 2007 18:11:05 -0500 schrieb Alan in NJ:

The following properly prints the attachments to a selected email in the
Inbox, but am trying to use it as a script in a Rule that only runs for a
particular sender. I believe the problem that I am not "selecting" the
just-received email that triggers the rule. Any help would be appreciated

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String,
_
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub PrintAttachment(Item As Outlook.MailItem)



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
Dim strFile As String

'Set destination folder
myOrt = "C:\program files\microsoft office\"


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 myAttachments.Count 0 Then
'for all attachments do...
For i = 1 To myAttachments.Count
'save them to destination
myAttachments(i).SaveAsFile myOrt &
myAttachments(i).DisplayName
strFile = myOrt & myAttachments(i).DisplayName

ShellExecute 0&, "print", strFile, 0&, 0&, 0&
NextOne:

Next i

myItem.Save

End If
Next
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing



End Sub




AlanNJ