Michael,

Thanks for your reply...

I actually got my answer in another thread:

Here is my finished product if anyone was interested:
__________________________________________________________________________________
Special thanks to:  Eric Legault, Steven Harvey, and Sue Mosher for helping
derive the version posted below.
__________________________________________________________________________________
Sub ArchiveToFolder()
On Error Resume Next

   Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
   Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
   Dim myFolder As String

   myFolder = Format(Date, "yyyy")  ' My personal folder is labeled as the
current year (ie - '2007')

   Set objNS = Application.GetNamespace("MAPI")
   Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
   Set objFolder = objNS.Folders(myFolder)

   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 FolderExist(objItem.SenderName) = False Then
       objFolder.Folders.Add (objItem.SenderName)
   End If

       Set objFolder = objNS.Folders(myFolder).Folders(objItem.SenderName)

       If objFolder.DefaultItemType = olMailItem Then
           If objItem.Class = olMail Then
               objItem.Move objFolder
               Set objFolder = objNS.Folders(myFolder)
           End If
       End If
   Next

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

End Sub

Function FolderExist(sFileName As String) As Boolean
   FolderExist = IIf(Dir(sFileName, vbDirectory) <> "", True, False)
End Function
__________________________________________________________________________________

Mark Ivey