I am not sure of the best way to do this, I did it in VBA because I could. It does some stuff that I am sure does not apply to your situation, but I as sure that you can take out what you do not neeed.
<CODE>
Public Function ImportInbox()
On Error GoTo Err
Dim TempRst As Recordset
Dim OlApp As Outlook.Application
Dim Inbox As Outlook.mapiFolder
Dim InboxItems As Outlook.items
Dim Mailobject As Object
Set OlApp = CreateObject("Outlook.Application"

Set Inbox = OlApp.GetNamespace("Mapi"

.GetDefaultFolder(olFolderInbox)
Set TempRst = CurrentDb.OpenRecordset("tblInbox"

Set InboxItems = Inbox.items
For Each Mailobject In InboxItems
With TempRst
.AddNew
TempRst!inboxSubject = IIf(Mailobject.Subject = "", " ", Mailobject.Subject)
TempRst!inboxFrom = Mailobject.SenderName
Dim loc, locLen, locPos As Integer
Dim locString As String
Dim locStr As String
locStr = "a"
locPos = 0
locLen = Len(Mailobject.SenderName)
Do While IsNumeric(locStr) = False And locPos <> locLen
locPos = locPos + 1
locStr = Mid(Mailobject.SenderName, locPos, 1)
Loop
Dim dbGetRegion As Database
Dim qryGetRegion As QueryDef
Dim rstGetRegion As Recordset
Set dbGetRegion = CurrentDb
If locPos < locLen Then
locString = Mid(Mailobject.SenderName, locPos, 3)
loc = locString
'gets the loc
Set qryGetRegion = dbGetRegion.CreateQueryDef("", "SELECT FacilityCode, REGION FROM Facility WHERE FacilityCode=" & loc)
Set rstGetRegion = qryGetRegion.OpenRecordset()
!loc = loc
ElseIf InStr(1, Mailobject.SenderName, ","

> 0 Then
Dim lName As String
lName = "*" & Left(Mailobject.SenderName, (InStr(1, Mailobject.SenderName, ","

) - 1) & "*"
'gets the region or district
Set qryGetRegion = dbGetRegion.CreateQueryDef("", "SELECT NAME, POSITION, [REGION #], DISTRICT FROM tblEMailLPMs WHERE NAME Like '" & lName & "'"

Set rstGetRegion = qryGetRegion.OpenRecordset()
If rstGetRegion.EOF = False Then
If rstGetRegion!Position = "DLPM" Then
!DISTRICT = rstGetRegion!DISTRICT
Else
![Region] = rstGetRegion![REGION #]
End If
Else
Set qryGetRegion = dbGetRegion.CreateQueryDef("", "SELECT Name, Position, Location FROM tblEMailWHSE WHERE Name Like '" & lName & "'"

Set rstGetRegion = qryGetRegion.OpenRecordset()
If rstGetRegion.EOF = False Then
!loc = rstGetRegion!Location
End If
End If
Else
Dim lName1, lName2, lName3 As String
lName1 = InStr(1, Mailobject.SenderName, "."

+ 1
lName2 = InStr(1, Mailobject.SenderName, "@"

lName3 = Mid(Mailobject.SenderName, lName1, (lName2 - lName1))
lName = "*" & lName3 & "*"
Set qryGetRegion = dbGetRegion.CreateQueryDef("", "SELECT NAME, POSITION, [REGION #], DISTRICT FROM tblEMailLPMs WHERE NAME Like '" & lName & "'"

Set rstGetRegion = qryGetRegion.OpenRecordset()
If rstGetRegion.EOF = False Then
If rstGetRegion!Position = "DLPM" Then
!DISTRICT = rstGetRegion!DISTRICT
Else
![Region] = rstGetRegion![REGION #]
End If
Else
Set qryGetRegion = dbGetRegion.CreateQueryDef("", "SELECT Name, Position, Location FROM tblEMailWHSE WHERE Name Like Like '" & lName & "'"

Set rstGetRegion = qryGetRegion.OpenRecordset()
End If
End If
If InStr(1, Mailobject.Body, "Code:"

> 0 Then
!code = Mid(Mailobject.Body, (InStr(1, Mailobject.Body, "Code:"

) + 5, 3)
Else
!code = 0
End If
!inboxCC = IIf(Mailobject.CC = "", " ", Mailobject.CC)
!inboxto = IIf(Mailobject.To = "", " ", Mailobject.To)
!inboxBody = IIf(Mailobject.Body = "", " ", Mailobject.Body)
!inboxdatesent = Mailobject.SentOn
.Update
Mailobject.Unread = False
Mailobject.DELETE
End With
Next
Set OlApp = Nothing
Set Inbox = Nothing
Set InboxItems = Nothing
Set Mailobject = Nothing
Set TempRst = Nothing
Err:
End Function
</code> The hardest questions always have the easiest answers.