> Hello,
> MS OUTLOOK 2003 on XP PRO
> Awhile ago I was looking for how to do this and it was irritating me that

> 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

> 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

> 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

> 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()
> classHandler.Initialize_handler
> 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 =
> myolApp.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).Items
> 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

> appears in the OUTLOOK window, below your inbox
> str_folder = "Email" 'This is the name of the folder

> 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
> Item.Save
>
> 'Debug.Print Item.Subject
>
> End Sub