Attribute VB_Name = "AJOutlookMacros"
' atulvij.com Outlook Intermediate, Lesson 7. Import in Outlook: Alt+F11 > File > Import File.
' These macros only read mail and save copies of attachments; none of them deletes or sends anything.
' Checked by reading against the Outlook object model; test on a few mails first.
Option Explicit

' 1. Save attachments of the SELECTED mails to a folder, prefixing each file with the received date.
Public Sub SaveSelectedAttachments()
    Dim folder As String: folder = Environ("USERPROFILE") & "\Documents\Mail Attachments\"
    If Dir(folder, vbDirectory) = "" Then MkDir folder
    Dim item As Object, att As Object, n As Long
    For Each item In Application.ActiveExplorer.Selection
        If TypeName(item) = "MailItem" Then
            For Each att In item.Attachments
                If att.Type = 1 Then          ' olByValue: a real file (skips embedded signature images in most cases)
                    att.SaveAsFile folder & Format(item.ReceivedTime, "yyyy-mm-dd") & " " & CleanName(att.FileName)
                    n = n + 1
                End If
            Next att
        End If
    Next item
    MsgBox n & " attachment(s) saved to " & folder, vbInformation
End Sub

' 2. Count unread mail per folder in the Inbox tree (a quick "where is the backlog?" report).
Public Sub UnreadReport()
    Dim out As String
    out = CountUnread(Application.Session.GetDefaultFolder(6), "")   ' 6 = olFolderInbox
    MsgBox out, vbInformation, "Unread mail"
End Sub

Private Function CountUnread(f As Object, indent As String) As String
    Dim s As String, sub_ As Object
    If f.UnReadItemCount > 0 Then s = indent & f.Name & ": " & f.UnReadItemCount & vbCrLf
    For Each sub_ In f.Folders
        s = s & CountUnread(sub_, indent & "   ")
    Next sub_
    CountUnread = s
End Function

' 3. Reply with a template (.oft) to the selected mail, keeping the original thread.
Public Sub ReplyWithTemplate()
    Dim orig As Object, tmpl As Object
    Set orig = Application.ActiveExplorer.Selection(1)
    Set tmpl = Application.CreateItemFromTemplate(Environ("APPDATA") & "\Microsoft\Templates\Payment reminder.oft")
    With orig.Reply
        .HTMLBody = tmpl.HTMLBody & .HTMLBody
        .Display                                    ' shows the reply; you check and press Send yourself
    End With
End Sub

Private Function CleanName(s As String) As String
    Dim c As Variant
    For Each c In Array("\", "/", ":", "*", "?", """", "<", ">", "|")
        s = Replace(s, c, "_")
    Next c
    CleanName = s
End Function
