what did you change??

Thank you so much for the code. I finally had some time to give it a run thru, and it appears to work initially, though I get an error 13 – type mismatch. Any thoughts?

Here is what I have (I added the '————- for better visibility)
Function CheckForFolder(strFolder As String) As Boolean
' looks for subfolder of specified folder, returns TRUE if folder exists.
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olInbox As Outlook.MAPIFolder
Dim FolderToCheck As Outlook.MAPIFolder

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)

' try to set an object reference to specified folder
On Error Resume Next
Set FolderToCheck = olInbox.Folders(strFolder)
On Error GoTo 0

If Not FolderToCheck Is Nothing Then
CheckForFolder = True
End If

ExitProc:
Set FolderToCheck = Nothing
Set olInbox = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Function
'——————————————————————————————-
Function CreateSubFolder(strFolder As String) As Outlook.MAPIFolder
' assumes folder doesn't exist, so only call if calling sub knows that
' the folder doesn't exist; returns a folder object to calling sub
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olInbox As Outlook.MAPIFolder

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)

Set CreateSubFolder = olInbox.Folders.Add(strFolder)

ExitProc:
Set olInbox = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Function

'————————————-
Public Sub MoveIt()
On Error GoTo ErrorHandler

Dim fldr As Outlook.MAPIFolder
Dim msg As Outlook.MailItem
Dim targetFolder As Outlook.MAPIFolder
Dim senderName As String

Set fldr = GetNS(GetOutlookApp).PickFolder

If fldr Is Nothing Then GoTo ErrorHandler

For Each msg In fldr.Items

' move received email to target folder based on sender name
senderName = msg.senderName

If CheckForFolder(senderName) = False Then ' Folder doesn't exist
Set targetFolder = CreateSubFolder(senderName)
Else
Set targetFolder = _
GetNS(GetOutlookApp).GetDefaultFolder(olFolderInbox).Folders(senderName)
End If

msg.Move targetFolder

Next msg

ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " – " & Err.Description
Resume ProgramExit
End Sub
'——————————————————————-
Function GetOutlookApp() As Outlook.Application
' returns reference to native Outlook.Application object
Set GetOutlookApp = Outlook.Application
End Function
'————————————————————————-
Function GetNS(ByRef app As Outlook.Application) _
As Outlook.NameSpace
' returns a Namespace Object to access MAPIFolder objects
Set GetNS = app.GetNamespace("MAPI")
End Function

Thanks
Adam

Set objFolder = objNS.Folders("Old Mail").Folders("Personal")

Set myFolder = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("personal")

This program works fine if i have a folder inside my Inbox called personal. However, i have it inside a folder stored and backup up on our network called Old Mail its a .pst file. So, i have a "Personal" folder inside of "Old Mail". So I edited the line to this:

Set myFolder = Outlook.Session.GetDefaultFolder("Old Mail").Folders("Personal")

Now i have a run-time error 13 i think it was. The original code i posted to find this folder worked.
Set objFolder = objNS.Folders("Old Mail -Beeson").Folders("Personal")

I have since renamed the folder to simply "Old Mail"
Can it not find the folder because of the ".GetDefaultFolder"?

Run-Time error '459':
Object or class does not support the set of events

It then points to this line of code -> Set msg = objExplorer.Selection(1)

I'm not sure whats its looking for at Run-time that's not available. That's a part of the code I'm not familiar with. I did change the name of the person in the code.

This code will automatically move emails from a given sender to a subfolder called "personal" whenever an email from that sender is read. Edit as needed. Note that opening emails will also mark them as read.

Try this. It lets you pick a folder and then loops through it, moving the items based on sender name into their own folders one level below the default Inbox. If the folder doesn't exist, it is created. You'll also need to grab the CheckForFolder and CreateSubFolder procedures, found at Look for and create folders programmatically.

Instead of the code running anytime a new item is added to the reference folder, I would like to tell it when to run. I currently am using rules in 2007 to move emails from members of a select department in our company into their own personal folders. I have so many of these now, that I do not see them unless I scroll down thru my subfolders. A more ideal situation is to have them all come into one folder labeled with the department name. On Friday, I would like to run the macro to move any of these messages that are read to the folder of that sender. This way I can manage my unread and todo items from the sender before moving the items.

Any thoughts?

Thanks
Adam