Solved: Print emails by Date Received Ascending

[mdmackillop]

This is my code for printing emails and saving attachments which works fine. I want to ensure that printing takes place in the correct order for ease of filing. i.e. Sort by Date Received prior to processing


Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim StrFile As String
Dim StrFolderPath As String
Dim strFolder As String
Dim strDeletedFiles As String
Dim EmailFolder As String
Dim AttFolder As String
Dim FirstCount As Long
Dim strPrompt As String
Dim RecDate As String
Dim StrDate As String
Dim DelMails As Long
Dim strCopiedFiles As String
Dim Response As Integer

On Error Resume Next
StrFolderPath = "M:\" & JobFolder(InputBox("Job No."))
'StrFolderPath = "M:\" & JobFolder(1128)
Response = MsgBox("Save emails to " & StrFolderPath & "?", vbYesNo + vbQuestion)
If Response = vbNo Then Exit Sub

If MyFolderExists(StrFolderPath) = False Then
MsgBox "Folder not found"
Exit Sub
End If

'Make folders if required
EmailFolder = StrFolderPath & "\Emails\"
If Not MyFolderExists(EmailFolder) Then MkDir EmailFolder
AttFolder = StrFolderPath & "\Attachments\"
If Not MyFolderExists(AttFolder) Then MkDir AttFolder
DelMails = vbYes 'MsgBox("Do you wish to delete emails?", vbYesNoCancel)
If DelMails = vbCancel Then Exit Sub
Set wdApp = New Word.Application
Set fs = wdApp.FileSearch
' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection

'SortByDate here? ********************************************************

' Check each selected item for attachments.
For Each objMsg In objSelection
'objMsg.PrintOut
strCopiedFiles = ""
RecDate = Format(objMsg.ReceivedTime, "yymmdd - ")
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
If lngCount > 0 Then
FirstCount = Copied(AttFolder)
For i = lngCount To 1 Step -1
' Get the file name.
StrFile = objAttachments.Item(i).FileName
StrFile = DocSave(AttFolder, StrFile, RecDate, True)
objAttachments.Item(i).SaveAsFile StrFile
'***************************************
'objAttachments.Item(i).Delete
strCopiedFiles = AddFileSave(strCopiedFiles, objMsg, StrFile)
Next i
'MsgBox Copied(AttFolder) - FirstCount & " attachment(s) copied to " & AttFolder
End If
' Adds the filename string to the message body and save it
' Check for HTML body
If lngCount > 0 Then
If objMsg.BodyFormat <> olFormatHTML Then
objMsg.Body = objMsg.Body & vbCrLf & _
"The file(s) were saved to " & strCopiedFiles
Else
objMsg.HTMLBody = objMsg.HTMLBody & "<p>" & _
"The file(s) were saved to " & strCopiedFiles
End If
objMsg.Save
End If

Call SaveDeleteEmail(objMsg, EmailFolder, RecDate)

'If MsgBox("Print email?", 36) = vbYes Then objMsg.PrintOut
objMsg.PrintOut
Next
ExitSub:
wdApp.Quit
Set wdApp = Nothing
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

[Charlize]

I think that you cannot sort the items in the inbox. You can sort the taskfolder on DueDate. Maybe create a task for every item that you want to process with a certain word in the subject ... 'To Print' maybe.

Then sort the items in the taskfolder on duedate and loop through every item and check on this word in the subject. Locate the mail in the inbox with the same subject and perform the actions that you want.

Or when creating the taskitems, add the attachments by coding and process the taskfolder without the comparisation. But the attachements of a task could give some problems (Haven't tried that one yet but I think that I've read somewhere that it could be cumbersome --- taskitems and included attachments ---.)

[mdmackillop]

Thanks Charlize.
It's not critical. I'll just add a message box reminder to sort before processing.
Regards
MD