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
...
Else
MsgBox "Folder '" & sbDateStr & "' doesnt exist"
Endif
Endif
Next

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
Organize eMails:
http://www.vboffice.net/product.html?id=2006063&cmd=detail&lang=en&pub=6

Am Wed, 18 Jul 2007 05:07:16 -0000 schrieb :

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

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
Folders").Folders("200707-In")
'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
Next

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

End Sub



Thanks
Stu