- Joined
- May 16, 2012
- Messages
- 1
- Reaction score
- 0
I am trying to find a way to mark an incoming message from specific senders to copy the item into specific folders and mark the copied item as read but keep the original as unread.
More info if you care for it: At work they automatically delete items out of the inbox after 90 days if they haven't been moved into the archive folders and I often lose vital information. I would like for emails sent from someone to go into a file with their name on it automatically and keep the original in the inbox so I can delete or let it delete after 90 days automatically.
Here is what I was trying but it doesn't seem to be working:
I appreciate any help in the matter thank you!
More info if you care for it: At work they automatically delete items out of the inbox after 90 days if they haven't been moved into the archive folders and I often lose vital information. I would like for emails sent from someone to go into a file with their name on it automatically and keep the original in the inbox so I can delete or let it delete after 90 days automatically.
Here is what I was trying but it doesn't seem to be working:
Private Sub Application_Startup()
Initialize_handler
End Sub
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
Private Sub myOlItems_ItemAdd(ByVal myItem As Object)
Dim myInbox As Outlook.MAPIFolder
Dim myFolder As Outlook.MAPIFolder
Dim myNewFolder As Outlook.MAPIFolder
Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myNewFolder = myInbox.Folders("EMAIL") 'EMAIL is in a PST file.
myItem.Copy myNewFolder
myItem.UnRead = False
myItem.Save
End Sub
Initialize_handler
End Sub
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
Private Sub myOlItems_ItemAdd(ByVal myItem As Object)
Dim myInbox As Outlook.MAPIFolder
Dim myFolder As Outlook.MAPIFolder
Dim myNewFolder As Outlook.MAPIFolder
Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myNewFolder = myInbox.Folders("EMAIL") 'EMAIL is in a PST file.
myItem.Copy myNewFolder
myItem.UnRead = False
myItem.Save
End Sub
I appreciate any help in the matter thank you!