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