Inbox Rule: Auto Print Attachments "Alan in NJ" <devildad77[ at ]comcast.net> 1/19/2007 11:11:05 PM 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

Re: Inbox Rule: Auto Print Attachments "Michael Bauer [MVP - Outlook]" <mb[ at ]mvps.org> 1/20/2007 8:42:30 AM 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?productid=300120654&languageid=1 (German: http://www.VBOffice.net/product.html?pub=6) Am Fri, 19 Jan 2007 18:11:05 -0500 schrieb Alan in NJ: [Quoted Text] > 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

Re: Inbox Rule: Auto Print Attachments "Alan in NJ" <devildad77[ at ]comcast.net> 1/21/2007 3:57:12 PM Many thanks, Michael. I removed the loop, deleted the ref to Dim myOlApp, and inserted the following with the name of the sender instead of the NOS: Set myOlApp = CreateObject("Outlook.Application") Set myNameSpace = myOlApp.GetNamespace("MAPI") Set myFolder = _ myNameSpace.GetDefaultFolder(olFolderInbox) Set myItem = myFolder.Items.Find _ ("[SenderName] = 'NOS") I think it should work, though not as clean as you would do. Any comments would be appreciated as I am trying to get better at this! Alan "Michael Bauer [MVP - Outlook]" <mb[ at ]mvps.org> wrote in message news:120bo6nt14fl$.15v0d00fdv8l4.dlg[ at ]40tude.net... [Quoted Text] > > 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?productid=300120654&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

Re: Inbox Rule: Auto Print Attachments "Michael Bauer [MVP - Outlook]" <mb[ at ]mvps.org> 1/22/2007 5:17:42 AM Set myOlApp = CreateObject("Outlook.Application") and Dim myOlApp As New Outlook.Application and Set myOlApp = New Outlook.Application are almost equal. From within Outlook don't use that. And then replace the remaining 'myOlApp' by 'Application'. The reason is that Outlook runs already, don't try to create a new instance (which however doesn't work but may cause problems). As I understand you, you have a rule calling that script for a particular e-mail. In that case the rule passes a reference to the e-mail to the script, it's the 'Item' variable in the script declaration. So there's no need to search for the item again, neither by a loop or the Find function. -- Viele Gruesse / Best regards Michael Bauer - MVP Outlook Keep your Outlook categories organized! http://www.shareit.com/product.html?productid=300120654&languageid=1 (German: http://www.VBOffice.net/product.html?pub=6) Am Sun, 21 Jan 2007 10:57:12 -0500 schrieb Alan in NJ: [Quoted Text] > Many thanks, Michael. > > I removed the loop, deleted the ref to Dim myOlApp, and inserted the > following with the name of the sender instead > of the NOS: > > Set myOlApp = CreateObject("Outlook.Application") > Set myNameSpace = myOlApp.GetNamespace("MAPI") > Set myFolder = _ > myNameSpace.GetDefaultFolder(olFolderInbox) > Set myItem = myFolder.Items.Find _ > ("[SenderName] = 'NOS") > > > I think it should work, though not as clean as you would do. Any comments > would be appreciated as I am trying to get better at this! > > Alan > > > > > > "Michael Bauer [MVP - Outlook]" <mb[ at ]mvps.org> wrote in message > news:120bo6nt14fl$.15v0d00fdv8l4.dlg[ at ]40tude.net... >> >> 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?productid=300120654&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

RE: Inbox Rule: Auto Print Attachments Michiel 2/7/2007 2:13:00 PM with a lot of help from Killian posting this on http://www.vbaexpress.com/kb/getarticle.php?kb_id=522 I used the following sollution for this problem 1. make a new map in outlook 2. make a rule to move specific mail with attachments to move to that folder 3. find selfcert.exe in the office directory and make a selfsigned certificate (this is to prevent annoying macro security messages later) 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 Option Explicit Dim WithEvents TargetFolderItems As Items 'set the string constant for the path to save attachments make sure this path excists Const FILE_PATH As String = "c:\temp" '############################################################################### '### this is the Application_Startup event code in the ThisOutlookSession module Private Sub Application_Startup() 'some startup code to set our "event-sensitive" items collection Dim ns As Outlook.NameSpace Dim Gebruikersnaam As String Set ns = Application.GetNamespace("MAPI") 'This part makes sure the full path name of the outlook folder is taken (including username) make sure this 'is too in your case Uname= ns.CurrentUser Set TargetFolderItems = ns.Folders.Item("Postbus - " & Uname).Folders.Item("your folder").Items End Sub '############################################################################### '### this is the ItemAdd event code Sub TargetFolderItems_ItemAdd(ByVal Item As Object) 'when a new item is added to our "watched folder" we can process it Dim olAtt As Attachment Dim i As Integer If Item.Attachments.Count > 0 Then For i = 1 To Item.Attachments.Count Set olAtt = Item.Attachments(i) 'save the attachment olAtt.SaveAsFile FILE_PATH & olAtt.FileName If UCase(Right(olAtt.FileName, 3)) = "PDF" Then PrintPdf (FILE_PATH & olAtt.FileName) End If Next End If Set olAtt = Nothing End Sub '############################################################################### '### this is the Application_Quit event code in the ThisOutlookSession module Private Sub Application_Quit() Dim ns As Outlook.NameSpace Set TargetFolderItems = Nothing Set ns = Nothing End Sub '############################################################################### '### print routine Sub PrintPdf(fFullPath As String) ShellExecute 0&, "print", fFullPath, 0&, 0&, 0& End Sub '################################################################################ '############################################################################### 4. add from the menu Extra a digital signature to the macro you created earlier 5. after starting outlook again you select allways trust this publisher Any ideas about fixing the problem with printing multiple pdf attachments that not all documents are printed.... perhaps a sleep somewhere? (possible by making a seperate module with Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) in it)