Move email to folder based on ReceivedTime



I have some code that I've attach to a menu button that will
move a selected email to a hard coded predefined folder. I would
like the code to look at the ReceivedTime of the selected email and
set the target objFolder to based on the ReceivedTime. If the
ReceivedTime is say '01/02/2007 03:35:40 PM' I want to set the
objFolder to 200702-In. I can get the folder name with the following
line of

sbDateStr = Mid(objItem.ReceivedTime, 7, 4) & Mid
(objItem.ReceivedTime, 4, 2) & "-In"

I just can't figure out how to set objFolder to the value stored in
sbDateStr. I'd also like to have an error routine to detect if
200702-In exists before attempting t move the email. Here's the code
I have so far.

Sub sbmovemsgs()

Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
Dim sbDateStr As String
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = Application.GetNamespace("MAPI").Folders("Personal
'Set objFolder = objInbox.Parent.Folders("Stuart")
'Assume this is a mail folder

If objFolder Is Nothing Then
MsgBox "This folder doesn't exist!", vbOKOnly +
vbExclamation, "INVALID FOLDER"
End If

If Application.ActiveExplorer.Selection.Count = 0 Then
'Require that this procedure be called only when a message is selected
Exit Sub
End If

For Each objItem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move objFolder
'how do I set objFolder to the value in sbDateStr below
'sbDateStr = Mid(objItem.ReceivedTime, 7, 4) &
Mid(objItem.ReceivedTime, 4, 2) & "-In"
End If
End If

Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing

End Sub


Michael Bauer [MVP - Outlook]

Because Selection.Count=0 means no action I'd put that on top. In general
(also within the loop): Don't do unnecessary actions if the requirements
aren't given.

Then use one variable for the parent's Folders collection:

Dim ParentFolders as outlook.Folders
Set ParentFolders=objNS.Folders("Personal Folders").Folders

As your target folder might change for each objItem, the ref to it must be
set within the For Each loop:

For Each ...
If objItem.Class = olmail Then
sbDateStr = ....
Set objFolder=ParentFolders(sbDateStr)
If not objFolder is nothing then
If objFolder.DefaultItemType = olMailItem Then
MsgBox "Folder '" & sbDateStr & "' doesnt exist"

Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
Organize eMails:

Am Wed, 18 Jul 2007 05:07:16 -0000 schrieb (e-mail address removed):

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question