The code below archives my messages into a local folder. What I want to do
is to have each message stamped with an 'Archived' noted so I know it has
already been done and have the code skip that message.

The problem I am having is that the 'Archived to" string is only inserted
into the message body that I have selected when I exectute the code. If I
have no messages select, none of them are altered.

The messages save ok, but what am I missing that keeps the itm.Body from
being updated?

Sub SaveMessages()

Dim OL As Application
Dim NmeSpace As NameSpace
Dim SubTxt As String

Set OL = CreateObject("Outlook.Application")
Set NmeSpace = OL.GetNamespace("MAPI")
Set Inbx = NmeSpace.GetDefaultFolder(olFolderInbox)
Set fldr = Application.ActiveExplorer.CurrentFolder
DirName = "C:\Documents and Settings\PJFry\Email\"

For Each itm In fldr.Items

SubTxt = itm.Subject
SubTxt = Replace(SubTxt, "_", "")
SubTxt = Replace(SubTxt, "´", "'")
SubTxt = Replace(SubTxt, "`", "'")
SubTxt = Replace(SubTxt, "{", "(")
SubTxt = Replace(SubTxt, "[", "(")
SubTxt = Replace(SubTxt, "]", ")")
SubTxt = Replace(SubTxt, "}", ")")
SubTxt = Replace(SubTxt, "/", "-")
SubTxt = Replace(SubTxt, "\", "-")
SubTxt = Replace(SubTxt, ":", "")
SubTxt = Replace(SubTxt, ",", "")
'Cut out invalid signs.
SubTxt = Replace(SubTxt, "*", "'")
SubTxt = Replace(SubTxt, "?", "")
SubTxt = Replace(SubTxt, """", "'")
SubTxt = Replace(SubTxt, "", "")
SubTxt = Replace(SubTxt, "", "")
SubTxt = Replace(SubTxt, "|", "")


FNme = DirName & Trim(SubTxt) & " " & Format(itm.ReceivedTime,
"yy.mm.dd") & " " & itm.SenderName & ".msg"

If itm.Class = olMail Then
If InStr(1, itm.Body, "Archived to") 0 Then
'do nothing
Else
itm.Body = itm.Body & vbCrLf & _
"Archived to " & DirName & " on " & Now()
itm.SaveAs FNme, olMSG
End If
End If


Next itm


End Sub


If there is a better way to accomplish the same thing, I would also love to
hear it.

Thanks!

PJ