View Single Post
  #2  
Old May 25th 07, 03:34 PM posted to microsoft.public.outlook.program_vba
Mark Ivey
external usenet poster
 
Posts: 15
Default Archiving Emails

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

"Michael Bauer [MVP - Outlook]" wrote in message
.. .


Do you want to move the messages into an Outlook folder or the file
system?

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
Quick-Cats - Categorize Outlook data:

http://www.vboffice.net/product.html?id=2006063&cmd=detail&lang=en&pub=6

Am Sun, 13 May 2007 19:47:36 -0500 schrieb Mark Ivey:

Is there a way to move all messages in my inbox to my personal archive
folder into a subfolder with the email name that each email is from (if
it
doesn't already exist).\

I am pretty proficient with VBA in MS Excel and have dabbled with

VBScript,
therefore I may need some basic instructions on how to put this final
package together as well.

TIA for any help...

Mark Ivey



Ads