how to Tableize emails from outlook into access 2007

[DawnTreader]

here is a post i put in the access forums, just want to make sure i have itsomewhere the right people can answer:

Borrowed this code from a few different sources to try and hash something together that would run through the email folders and dump specific information from the emails to a table called tblInbox. at the moment i am trying to get it to work with just one folder with in the users data folders. for example the folders for this user are set up like so:

Mailbox - Aftermarket
-Completed (a email folder)
-Algeria (a email folder)
-Canada (another email folder) etc...

i want to be able to get the emails in the completed folder and the sub folders algeria and canada and dump them to the table.

here is my current code.

Public Sub ImportMailFromOutlook()
On Error GoTo ImportMailFromOutlook_Error
' This code is based in Microsoft Access.

' Set up DAO objects (uses existing "tblContacts" table)
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("tblInbox")

' Set up Outlook objects.
Dim outlookApp As New Outlook.Application
Dim outlookNameS As Outlook.NameSpace
Dim mainFolder As Outlook.mapifolder
Dim mailFolder As Outlook.mapifolder
Dim mail As Outlook.mailItem
Dim objItems As Outlook.Items
Dim iNumMail As Integer
Dim i As Integer

Set outlookNameS = outlookApp.GetNamespace("MAPI")
' Set mailFolder = outlookNameS.PickFolder

' Set mailFolder = outlookNameS.Folders '.GetDefaultFolder(olFolderInbox)
' Set mainFolder = outlookNameS.GetDefaultFolder( '.Folders("Canada") 'outlookNameS.Folders
Set mailFolder = outlookNameS.Folders("Completed") 'mainFolder.Folders("Completed")
Set objItems = mailFolder.Items
iNumMail = objItems.Count
If iNumMail <> 0 Then
For i = 1 To iNumMail
If TypeName(objItems(i)) = "MailItem" Then
Set mail = objItems(i)
rst.AddNew
rst!OLID = mail.EntryID
rst!To = mail.To
rst!CC = mail.CC
rst!Subject = mail.Subject
rst!Body = mail.Body
rst!DateReceived = mail.ReceivedTime
rst!DateSent = mail.SentOn
rst!Category = mail.Categories
rst!ConversationIndex = mail.ConversationIndex
rst!Conversation = mail.ConversationTopic
rst!Importance = mail.Importance
rst!From = mail.SenderEmailAddress
rst!Region = mail.Parent
rst.Update
End If
Next i
rst.Close
MsgBox "Finished."
Else
MsgBox "No Mail to export."
End If

ImportMailFromOutlook_Exit:
Exit Sub

ImportMailFromOutlook_Error:
If Err.Number = 3022 Then
Resume Next
Else
MsgBox "Error #: " & Err.Number & " " & Err.Description
Resume ImportMailFromOutlook_Exit
End If

End Sub

i am stuck on how to address the sub folders. i can get the actual inbox fine and if i use the pick folder method i can do each folder seperately but there are around 40 folders and that number will increase over time.

is there a way to loop through and find each email folder and address it and then suck up the email data?

if possible is there an "index" of the folders or do you have to path it?

Any and all help appreciated.