Help Modifying the Print Attachments code

[Mister H]

Hi All: :hi:

Once again I seek the help of the VBA Experts. I am trying to modify a code that I want to use to print the PDF attachments in a specified folder. It is SORT of working. Here is the code:


Public Sub Print_Email_PDF_Attachments()
Dim Inbox As MAPIFolder
Dim Item As mailItem
Dim Atmt As Attachment
Dim Filename As String
Dim i As Integer

'Folder " 1) Faxes (PDFs) TO BE PRINTED " needs to be created under the User
Set Inbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders.Item("1) Faxes (PDFs) TO BE PRINTED")
For Each Item In Inbox.Items
For Each Atmt In Item.Attachments

' This line creates specific file names for each attachment with the Date/time received and
' uses a counter so the chance of file name duplication is reduced.
'make sure the folder " C:\PDF Faxes " exists
Filename = "C:\PDF Faxes\" & Format(Item.ReceivedTime, "mm-dd-yyyy_hh-nn-ss") & "-" & Right(Format(Timer, "#0.00"), 2) & "_" & Atmt.Filename

'This line saves the attachments.
Atmt.SaveAsFile Filename

'please change the program folder accordingly if the Acrobat Reader is not installed on drive C:
'Shell """C:\Program Files\Adobe\Reader 8.0\Reader\acrord32.exe"" /h /p """ + FileName + """", vbHide
Shell """C:\Program Files\Adobe\Reader\acrord32.exe"" /h /p """ + Filename + """", vbHide


'Is there more then 1 attachment? If so then goto the next one
Next

'Now what do you want to do with the email message?
'Item.Delete '‘remove this line if you don’t want the email be deleted automatically
Item.Move Outlook.Session.GetDefaultFolder(olFolderInbox).Parent.Folders.Item("2) Faxes (PDFs) ALREADY PRINTED")

'Mark the email as Read
Item.UnRead = False
Next
Set Inbox = Nothing

End Sub


Problems: If I have 3 emails in the folder:
" 1) Faxes (PDFs) TO BE PRINTED " it prints the attachments of 2 of the files but not the 3rd one. Another problem is that the files remain on my C drive and Adobe is left open.

Can this code be modified so that:
1) It cycles through ALL emails in the specified folder and prints all the attachments and then moves all the emails to the other folder

2) I do not wish to keep the files that were saved to my folder C:\PDF Faxes How can I delete all the files after they are printed.

3) Can Adobe be closed and then the code return me to Outlook?

* Just thinking about the future is it simple to change the code so it will print ALL attachments regardless of type (excel, word and adobe)

THANKS to anyone that can assist.
Mark

[JP2112]

I would avoid using keywords like "Item" because VBA already uses that.

If you are moving files, you should use a backwards loop. i.e.


For i = Inbox.Items.Count To 1 Step -1
' Inbox.Items.Item(i) is the current item

Inbox.Items.Item(i).Move wherever
Next i


See if you can leverage this code (http://www.jpsoftwaretech.com/open-or-print-files-in-vba/) to avoid having to open Adobe.

Changing those two parts might solve all of your issues.

[Mister H]

Hi JP2112:

THANKS for your help.

I am not very familar with VBA in Outlook (or elsewhere) so I am not sure exactly how to insert this:


For i = Inbox.Items.Count To 1 Step -1
' Inbox.Items.Item(i) is the current item

Inbox.Items.Item(i).Move wherever
Next i

into the code I posted. When I get a chance I will read the link you provided (THANKS) and maybe that will answer my question. I did try inserting your code into mine and wound up getting errors so I obviously did not implement it correctly.

THANKS for your link, I have some reading to do. Hopefully it will explain how to delete the temp files as well.

Have a GREAT weekend,
Mark

[Mister H]

Hi: Just hoping that someone can help me modify my code by inserting JP2112 in the right spot and removing any part of the code that should be removed. I have played around but I can't get it to work for me so I know I am not inserting it in the right spot. I will try and implement the other code (link) when I return to the office but thought it would be nice to at least get my code above functioning correctly (in regards to looking at ALL emails in the specified folder). THANKS to anyone that can assist.

Take Care,
Mark

[JP2112]

Instead of

For Each Item In Inbox.Items

use


For i = Inbox.Items.Count To 1 Step -1


Of course you would need to declare the variable "i" somewhere at the top of your code.

Instead of Item.Attachments, Item.Move and Item.UnRead, use Inbox.Items.Item(i).Attachments, Inbox.Items.Item(i).Move and Inbox.Items.Item(i).UnRead. You literally just replace each one with the corresponding update.

[Mister H]

THANKS JP

I am doing something wrong because I am getting a Run time error now, Debug lands me on the Filename line. I an uncertain about the "declaring i as soemthing" as I see it mentioned already. Not sure how to proceed.

ANY further advice you offer is very much appreciated.

Here is what I changed the code to:


Public Sub Print_Email_PDF_Attachments()
Dim Inbox As MAPIFolder
Dim Item As mailItem
Dim Atmt As Attachment
Dim Filename As String
Dim i As Integer

Set Inbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders.Item("1) Faxes (PDFs) TO BE PRINTED")

'For Each Item In Inbox.Items
For i = Inbox.Items.Count To 1 Step -1

'For Each Atmt In Item.Attachments
For Each Atmt In Inbox.Items.Item(i).Attachments

'After Run Time Error - Debug take me to this line
Filename = "C:\PDF Faxes\" & Format(Item.ReceivedTime, "mm-dd-yyyy_hh-nn-ss") & "-" & Right(Format(Timer, "#0.00"), 2) & "_" & Atmt.Filename

Atmt.SaveAsFile Filename
Shell """C:\Program Files\Adobe\Reader\acrord32.exe"" /h /p """ + Filename + """", vbHide
Next

'Item.Move Outlook.Session.GetDefaultFolder(olFolderInbox).Parent.Folders.Item("2) Faxes (PDFs) ALREADY PRINTED")
Inbox.Items.Item(i).Move Outlook.Session.GetDefaultFolder(olFolderInbox).Parent.Folders.Item("2) Faxes (PDFs) ALREADY PRINTED")

'Item.UnRead = False
Inbox.Items.Item(i).UnRead = False

Next
Set Inbox = Nothing

End Sub


The error code I get is:
Run-time error `91`:

Object variable or With block variable not set

:banghead:

THANKS,
Mark

[Mister H]

Hi All:

After countless hours, many drinks and many aspirin I now have it working. I thought I would post it just in case anyone else has similar requirements. I left my comment4d lines in the code...

Here is what I changed the code to:


Public Sub Print_Email_PDF_Attachments()

Dim Inbox As MAPIFolder
Dim Item As mailItem
Dim Atmt As Attachment
Dim Filename As String
Dim i As Integer


'Folder " 1) Faxes (PDFs) TO BE PRINTED " needs to be created under the User
Set Inbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders.Item("1) Faxes (PDFs) TO BE PRINTED")
For i = Inbox.Items.Count To 1 Step -1
For Each Atmt In Inbox.Items.Item(i).Attachments

'This line creates specific file names for each attachment with the Date/time received and
'uses a counter so the chance of file name duplication is reduced.
'make sure the folder " C:\PDF Faxes " exists
Filename = "C:\PDF Faxes\" & Right(Format(Timer, "#0.00"), 2) & "-" & Atmt.Filename

'This line saves the attachments.
Atmt.SaveAsFile Filename

'please change the program folder accordingly if the Acrobat Reader is not installed on drive C:
'Shell """C:\Program Files\Adobe\Reader 8.0\Reader\acrord32.exe"" /h /p """ + FileName + """", vbHide
Shell """C:\Program Files\Adobe\Reader\acrord32.exe"" /h /p """ + Filename + """", vbHide

'Is there more then 1 attachment? If so then goto the next one
Next

'Mark the email as Read
Inbox.Items.Item(i).UnRead = False

'Now what do you want to do with the email message?
'If you want the email be deleted automatically
Inbox.Items.Item(i).Delete

'To move the item to s specified folder
'make sure the folder " C:\PDF Faxes " exists
'Use
'Inbox.Items.Item(i).Move Outlook.Session.GetDefaultFolder(olFolderInbox).Parent.Folders.Item("2) Faxes (PDFs) ALREADY PRINTED")
'Goto the Next email message
Next
Set Inbox = Nothing

End Sub


I need some further mods to it as it moves or delete the email regardless of it having a PDF attachment but if the user only puts the PDF files in the specified folder it is working.

Take Care,
Mark