I need to limit the size of my mailbox, so I have to create PST files on my hard drive. I have been just moving my mail to a PST, but this causes a problem of corruption to the file due to the size. So, I need to create many smaller PST files. I would like a macro that will do the following:

1) Look at an email address in my inbox and make a PST (if it dosent exist) with the email address as the name of the PST.
Example:

C:\Documents and Settings\"user name"\My Documents\"Sender"

2) Sort the email to that PST

3) Move to the next email, repeat

Anybody have a clue how to start? Also if possible sort the emails in the PST by folders based on date.

I believe this is an example by Sue Mosher, but I realy do not know what it does or how...I just know I cannot get it to work.

[vba]Function SetNewStore2(strFileName As String, strDisplayName As String) As Outlook.MAPIFolder
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim arr() As String
Dim i As Integer
On Error Resume Next

Set objOL = Application ' intrinsic Application object in Outlook VBA
Set objNS = objOL.GetNamespace("MAPI")

' build array of all the information store IDs
ReDim arr(objNS.Folders.Count - 1)
i = 0
For Each objFolder In objNS.Folders
arr(i) = objFolder.EntryID
i = i + 1
Next
Set objFolder = Nothing

objNS.AddStore strFileName
' make "best guess" that new store is the last one in the collection
Set objFolder = objNS.Folders.GetLast
' but confirm against array
If FolderEntryIDIsInArray(objFolder, arr()) Then
' check all top-level store folders against array
' until we find the one that doesn't have an
' EntryID in the array
For i = 1 To (objNS.Folders.Count - 1)
Set objFolder = objNS.Folders.GetPrevious
If Not FolderEntryIDIsInArray(objFolder, arr()) Then
Exit For
End If
Next
End If

' give the newly added PST store a display name
' This should be unique to make it easier to distinguish
' it from other stores.
objFolder.Name = strDisplayName

' these statements refresh the folder name
objNS.RemoveStore objFolder
Set objFolder = Nothing
objNS.AddStore strFileName

' repeat the earlier process to get the newly added store
' make "best guess" that new store is the last one in the collection
Set objFolder = objNS.Folders.GetLast
' but confirm against array
If FolderEntryIDIsInArray(objFolder, arr()) Then
' check all top-level store folders against array
' until we find the one that doesn't have an
' EntryID in the array
For i = 1 To (objNS.Folders.Count - 1)
Set objFolder = objNS.Folders.GetPrevious
If Not FolderEntryIDIsInArray(objFolder, arr()) Then
Exit For
End If
Next
End If

Set SetNewStore2 = objFolder

Set objOL = Nothing
Set objNS = Nothing
End Function

Function FolderEntryIDIsInArray(fld As Outlook.MAPIFolder, arr() As String) As Boolean
Dim blnInArray As Boolean
For i = 0 To UBound(arr)
If arr(i) = fld.EntryID Then
blnInArray = True
Exit For
End If
Next
FolderEntryIDIsInArray = blnInArray
End Function[/vba]

Thanks