> > 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