Move Sent Email to archival pst folder and mark as read - HOW TO



Awhile ago I was looking for how to do this and it was irritating me that it
was so hard to get a straight answer on how to pull this routine together.
So I thought I'd post sample code here to let everyone now how to do this
VERY simple thing.

Note: Occassionally, this thing de-initializes and won't trigger. If that
happens your email goes to your sent mail folder on the server side same as
always. No biggie, just close and re-open outlook to re-initialize or
manually run through the sub Application_Startup in the ThisOutlookSession
object. If I figure out how to prevent this from ever happening, I will
repost with better code.

I hope this is helpful to others. It really irked me that I couldn't find
seemingly simple sample code for this, so I thought I'd publish.

***I make no claims on the stability of this code, or it's reliability in
never causing problems. I believe it works well on my machine, and I think
it will work on yours but I have not rigorously tested it or done any
official software testing exercises. I am not responsible if this routine
eats your email by mistakes. It's not supposed to, but I don't KNOW that it
won't. Use at your own risk.

Macro to Mark as Read and Move to Archive Folder...

Copy and paste this to Objects 'This Outlook Session'
Dim classHandler As New cls_SentMail

Private Sub Application_StartUp()
End Sub

Put in Class Module named 'cls_SentMail'
Dim myolApp As New Outlook.Application
Public WithEvents myOlItems As Outlook.Items

Public Sub Initialize_handler()
Set myOlItems =
End Sub

Public Sub myOlItems_ItemAdd(ByVal Item As Object)

Dim myNewFolder As Outlook.MAPIFolder
Dim myNameSpace As Outlook.NameSpace

Dim str_path As String
Dim str_pst As String
Dim str_folder As String

' User Defined Variables
str_path = "XXXXXXX.pst" 'This is the complete filepath for the PST
file you are using as an archive
str_pst = "Current" 'This is the name of the PST file as it
appears in the OUTLOOK window, below your inbox
str_folder = "Email" 'This is the name of the folder inside
str_pst that you want sent email move to.

Set myNameSpace = myolApp.GetNamespace("MAPI")
myNameSpace.AddStore (str_path)

Set myNewFolder = myNameSpace.Folders(str_pst).Folders(str_folder)

Item.Move myNewFolder
Item.UnRead = False

'Debug.Print Item.Subject

End Sub

Michael Bauer [MVP - Outlook]

You had two questions and got two answers, which obviously helped you to
write this code. Why was that hard?

Best regards
Michael Bauer - MVP Outlook
Category Manager - Manage and share your categories:
SAM - The Sending Account Manager:

Am Thu, 20 May 2010 12:57:01 -0700 schrieb BlueWolverine:


Sorry. I think that was a bad day and I was in a rush. Looking back at all
the posts I got pretty good help.

I really appreciate all the hard work and help I've gotten from this forum.
I can't even begin to explain how much the Access and Excel sections bailed
me out, especially when I was learning Access.

Part of my irritation is that it felt like such a simple thing and I kept
thinking "There has to be sample code hanging around on the web for
this...There has to be something I can cherry pick." and then never finding
that. The other part is that I am used to the Access and Excel forums, where
I've typically gotten much more pseudocode based answers versus paragraphical

Sorry. Re-reading my post, I sound really bitter.

I appreciate the help.

Thank you once again, and thank you to all the MVPs and Helpful friends on
the forum.

Have a wonderful day.

MSE - Mech. Eng.

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question