Macro to print & move selected emails?

Status
Not open for further replies.

Scott@Atlas

New Member
Outlook version
Outlook 2007
Email Account
Exchange Server
Hi All,

The accounting staff in my office receive all manner of emails containing attachments from a multitude of vendors & have need to print a hard copy of each for auditing purposes - I've been attempting to build a custom button into the 32 bit version of Outlook 2007 to fire a script that would print one or more selected emails and any attachments contained therein, and then move that message to a specific folder within a local .pst file. I've tried cobbling it together from excerpts from http://www.slipstick.com/developer/macro-move-aged-mail/#case and http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders, along side numerous other forum entries, but it's become very clear to me that my limited experience with VBA isn't cutting it for this purpose. I'm hoping some kind soul has either a suggestion or a link to some prior article that might point me in the right direction.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Where are you running into problems? As problems go, this one is fairly easy to do, especially since there are a lot of code samples that do it. Basically, move it and then call the print macro (or print, then move). The one problem you might have is the button - Outlook 2007 supports buttons in the main window but not in opened messages.

Do you need to print the mail and the attachment or just the attachment?
Print attachments: http://www.slipstick.com/developer/print-attachments-as-they-arrive/
 

Scott@Atlas

New Member
Outlook version
Outlook 2007
Email Account
Exchange Server
I have it mostly assembled from assorted posts, although I have hit one snag I haven't been able to rectify. It'll print the selected emails, save a copy of any present attachments and print them, move it to a separate folder, and play a ridiculous noise to identify it's completed. The issue is that it'll print all of the emails, and then all of the attachments, which is apparently an aggravation in that the printouts must then be sorted to match back up the message with the attachment. Is there a way to iterate through the macro by having it print the email, print the attachment, and then move on to the next message in the active selections? Here's the whole of it so far:

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
Private Declare Function sndPlaySound32 _
Lib "winmm.dll" _
Alias "sndPlaySoundA" ( _
ByVal lpszSoundName As String, _
ByVal uFlags As Long) As Long

Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
Dim oFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer

On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If

'Convert folder path to array
FoldersArray = Split(FolderPath, "\")
Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If

'Return the oFolder
Set GetFolderPath = oFolder
Exit Function

GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function

Sub Accounting()

For Each itm In ActiveExplorer.Selection
itm.PrintOut
Next

Dim oMail As Outlook.MailItem
Dim obj As Object
For Each obj In ActiveExplorer.Selection
Set oMail = obj
Dim colAtts As Outlook.Attachments
Dim oAtt As Outlook.Attachment
Dim sFile As String
Dim sDirectory As String
Dim sFileType As String
'Define where to save a copy of the email attachment before printing
sDirectory = "C:\Users\test\Downloads\"
Set colAtts = oMail.Attachments
If colAtts.Count Then
For Each oAtt In colAtts
'This code looks at the last 4 characters in a filename
sFileType = LCase$(Right$(oAtt.FileName, 4))
Select Case sFileType
'Print these file types if they are saved as attachments on incoming emails.
'Add any additional file types below:
Case ".pdf", ".xls", "xlsx", "xlsm", ".doc", "docx", ".txt"
sFile = sDirectory & oAtt.FileName
oAtt.SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
End Select
Next
End If

Next

'Define the path to whatever sound to play when the macro completes
sndPlaySound32 "C:\Users\test\Desktop\duck_quack.wav", 0&

On Error Resume Next

Dim ns As Outlook.NameSpace
Dim moveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem

Set ns = Application.GetNamespace("MAPI")

'Define path to the destination folder in some other .pst file
Set moveToFolder = GetFolderPath("Archive\Reviewed")

If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No item selected")
Exit Sub
End If

If moveToFolder Is Nothing Then
MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
End If

For Each objItem In Application.ActiveExplorer.Selection
If moveToFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move moveToFolder
End If
End If
Next

Set objItem = Nothing
Set moveToFolder = Nothing
Set ns = Nothing

End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Sorry I missed this before... this problem:

The issue is that it'll print all of the emails, and then all of the attachments, which is apparently an aggravation in that the printouts must then be sorted to match back up the message with the attachment. Is there a way to iterate through the macro by having it print the email, print the attachment, and then move on to the next message in the active selections?
is due in part to the time it takes outlook to process the attachments - try adding a delay after each loop so there is time for the attachments to render.

Mike Sperry (of Sperry Software) explained this problem to me once - I'll see if i can find his comments.
 
Status
Not open for further replies.
Top