You never call itm.Save
Are you sure you want to modify &all* the messages in the Inbox folder
convertign them to plain text in the mean time?
Why not use Application.ActiveExplorer.Selection collection to give the user
more control over which messages get modified?
--
Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
-
"PJFry" <(E-Mail Removed)> wrote in message
news:10CC524F-8F98-44E4-8C10-(E-Mail Removed)...
> 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
Similar Threads
