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

[BlueWolverine]

Hello,
MS OUTLOOK 2003 on XP PRO
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()
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 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
Item.Save

'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:
<http://www.vboffice.net/product.html?lang=en>


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

 

[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
explanations.

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.




--
BlueWolverine
MSE - Mech. Eng.
Go BLUE!