'
' Reply To All in Plain Text, with Internet-style ">" quoting
'
' This allows you to use Outlook to reply to a mailinglist
'
' Copyright 2009 Matthijs van de Water
'
Sub ReplyAllPlain()

Dim app As New Outlook.Application
Set win = app.ActiveWindow
Dim Item As Outlook.MailItem

'Get MailItem based on EntryID, otherwise we'll get security warnings
If TypeOf win Is Outlook.Explorer Then
    Dim strID As String
    Dim olNS As Outlook.NameSpace
    strID = win.Selection.Item(1).EntryID
    Set olNS = Application.GetNamespace("MAPI")
    Set Item = olNS.GetItemFromID(strID)
Else
    Set Item = win.CurrentItem
End If

' Store name of the sender and date of sent message
Dim name As String
name = Item.SentOnBehalfOfName
datestr = Format(Item.SentOn, "yyyy-MM-ddTHH:mm:ss")

' ReplyToAll to this message in Plain formatting with > style
Item.BodyFormat = olFormatPlain
Item.Actions("Reply to All").ReplyStyle = olReplyTickOriginalText
Dim rply As Outlook.MailItem
Set rply = Item.ReplyAll

' Rebuild original body:
'  - Remove Outlook-style reply header
'  - Get rid of auto-inserted signature (optionally move to end of message)
orgBody = rply.Body
pos = InStr(orgBody, ">") - 1
sig = Left(orgBody, pos)
myBody = Mid(orgBody, pos + 1)
lines = Split(myBody, vbNewLine)
b = False
For Each myLine In lines
    If b Then
        newBody = newBody & myLine & vbNewLine
    End If
    If myLine = "> " Then
       b = True
    End If
Next
' Put new body together
rply.Body = "On " & datestr & ", " & name & " wrote:" _
           & vbNewLine & newBody & vbNewLine & sig

rply.Display

Item.Close olDiscard
End Sub