Here's how to do it:
1) Open your inbox in designer
2) Create an agent and paste in the code below
3) Run the agent
Here's the code:
Sub CreateDir (repdir As String, foldername As String)
' Check to see if the folder exists in windows, if not then create it
Dim folder As String
Dim restfolder As String
Slash = Instr(foldername, "\"
If Slash > 0 Then
folder = Mid(foldername, 1, Slash - 1)
restfolder = Mid(foldername, Slash + 1, Len(foldername) - Slash)
Else
folder = foldername
End If
dirfound = False
dirname = Dir (repdir & "*." , 16)
Do While dirname <> ""
If dirname = folder Then
dirfound = True
End If
dirname = Dir ()
Loop
If dirfound <> True Then
Print "Creating Directory """ & repdir & folder & """"
Mkdir repdir & folder
End If
' Recursive call if you are passed a nested folder
If Slash > 0 Then Call CreateDir (repdir & folder & "\", restfolder)
End Sub
Function dd (short As String)
' dd = double digit
If Len(short) < 2 Then
short = "0" & short
End If
dd = short
End Function
Sub Initialize
' This code was designed to go through a folder full of emails and dump their contents to a folder somewhere
' Written by Jalsa Kuldinow on 8/18/03
On Error Goto ErrTrap
ErrorArea = "Initialising"
Dim session As New notessession
Dim db As notesdatabase
Dim doc As NotesDocument
Dim rtitem As Variant
Dim fileCount As Integer
Dim repdir As String
Dim foldername As String
Set db = session.currentdatabase
' Get the respository directory from the user giving the previously used directory as the default
oldrepdir = session.GetEnvironmentString("RepDir"

repdir = Inputbox ("Please enter the full path where you would like your emails to be exported to (i.e. F:\Jalsa\)", _
"Entire Database Central Repository Export Function", oldrepdir)
If repdir = "" Then Exit Sub
Call session.SetEnvironmentVar("RepDir", repdir)
'Make sure the last char in the repository dir is a If Mid(repdir, Len(repdir), 1) <> "\" Then
repdir = repdir & "\"
End If
totalemailsexp = 0
Forall view In db.Views
ErrorArea = "Initialising"
If view.IsFolder And view.name <> "($Trash)" And view.name <> "(Group Calendars)" And _
view.name <> "($Alarms)" And view.name <> "(Rules)" Then
Print "Exporting Emails From """ & view.name & """"
If view.name = "($Inbox)" Then
foldername = "Inbox"
Else
foldername = view.name
End If
Call CreateDir (repdir, foldername)
' Start exporting emails
emailsexported = 0
Print "Exporting Emails to " & repdir & " from Folder " & foldername & " ... "
Set doc = view.getfirstdocument
While Not(doc Is Nothing)
ErrorArea = "Formatting"
d = doc.PostedDate(0)
If d = "" Then
d = doc.Created ' It's a draft
End If
' Format the time so that it looks good
ampm = Mid(d, Len(d) -1, 1) & Mid(d, Len(d), 1)
emaildate = Year(d) &"-"& dd(Month(d)) &"-"& dd(Day(d)) &" "& _
dd(Hour(d)) &"-"& dd(Minute(d)) &"-"& dd(Second(d)) & " " & ampm
emailsubject = doc.subject(0)
For i = 1 To Len(emailsubject)
cc = Mid (emailsubject, i, 1)
If cc="\" Or cc="/" Or cc=":" Or cc="*" Or cc="?" Or cc="""" Or cc="<" Or cc=">" Or cc="|" Then
Mid(emailsubject, i, 1) = " "
End If
Next
If Len(emailsubject) > 50 Then
emailsubject = Mid(emailsubject, 1, 50)
End If
ResumeFormatting:
' Put all attachments in a specific folder
ErrorArea = "Attaching"
Set rtitem = doc.GetFirstItem( "Body" )
If ( rtitem.Type = RICHTEXT ) Then
If doc.HasEmbedded Then
Forall o In rtitem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) Then
fileCount = fileCount + 1
Call o.ExtractFile ( repdir & foldername & "\" & emaildate & " " & o.name)
' Call o.remove
' Call doc.save (True, True)
End If
End Forall
End If
End If
ResumeAttaching:
' Strip the email of it's text and put that in a file.
ErrorArea = "Dumping"
emailtext = rtitem.GetFormattedText(True,80)
fileNum = Freefile
Print "Creating File " & repdir & foldername & "\" & emaildate & " " & Trim(emailsubject) & ".txt"
Open repdir & foldername & "\" & emaildate & " " & Trim(emailsubject) & ".txt" For Append As fileNum
Print #fileNum, "From " & doc.from(0) & " to " & doc.sendto(0) & " on " & doc.delivereddate(0)
Print #fileNum, doc.subject(0)
Print #fileNum, ""
Print #fileNum, emailtext
Close #fileNum
emailsexported = emailsexported + 1
totalemailsexp = totalemailsexp + 1
Print Cstr(emailsexported) & " Emails Exported From Folder """ & foldername & """"
Set doc = view.getnextdocument(doc)
ResumeDumping:
Wend
End If ' view.IsFolder
End Forall
' Finish the procedure and close the error log if generated
ResumeExit:
If ErrorLog Then
Print "Exporting Process Complete With Errors. Total of " & _
Cstr(totalemailsexp) & " Emails Exported. Please See Generated Error Log."
Print #Errfilenum, "Solution:"
Print #Errfilenum, "Please contact your local Lotus Notes developer."
Print #Errfilenum, ""
Close #Errfilenum
Else
Print "Exporting Process Complete. Total of " & Cstr(totalemailsexp) & " Emails Exported"
End If
Exit Sub
ErrTrap:
If Not ErrorLog Then
ErrfileNum = Freefile
Open repdir & "_Error Log.txt" For Append As Errfilenum
Print #Errfilenum, "Error Log Generated by Database Email Exporting Function. Run on " & Now
Print #Errfilenum, "Run by " & session.username
Print #Errfilenum, "Error Log:"
ErrorLog = True
End If
ErrMsg = "An error " & Err & " occurred on line " & Cstr(Erl) & _
" (" & Error & "

during the " & ErrorArea & " process."
Print #Errfilenum, ErrMsg
Print ErrMsg
Select Case ErrorArea
Case "Formatting" : Resume ResumeFormatting
Case "Attaching" : Resume ResumeAttaching
Case "Dumping" : Resume ResumeDumping
Case Else : Resume ResumeExit
End Select
End Sub