Outlook Oldest Email

[OrbitMascot]

I am working with a database in Access 97. The database currently extracts emails from Outlook and tracks the emails in Access. Everything in the database works fine. But the database randomly selects emails from Outlook. Is there a way for Access to extract the oldest email first? Any information would be greatly appreciated.

Here is the first part of the code:

Private Sub Command0_Click()
Forms!Main.TimerInterval = 0
Dim dbs As Database
Dim rst As DAO.Recordset
Dim rst1 As DAO.Recordset
Dim textline As String
Dim myselection As String
Dim text As String
Dim Line As String
Dim molApp As Outlook.Application
Dim molNameSpace As Outlook.NameSpace
Dim molMAPI As Outlook.MAPIFolder
Dim molItems As Outlook.Items
Dim molMail As Outlook.MailItem
Dim MyText As String
Dim X As Variant
Dim MyStart As Variant
Dim i As Variant 'Integer
Dim iCount As Variant 'Integer
Set rst = CurrentDb.OpenRecordset("tblEmail")
Set molApp = CreateObject("Outlook.Application")
Set molNameSpace = molApp.GetNamespace("MAPI")
Set molMAPI = molNameSpace.GetDefaultFolder(olFolderInbox)
Set molItems = molMAPI.Items
Dim objOLApp As Object, objFolder As Object, objItem As Object
Dim OlMapi As Object, mydestfolder As Object, SubFolder As Object
Set objOLApp = CreateObject("Outlook.Application")
Set OlMapi = objOLApp.GetNamespace("MAPI")
Set mydestfolder = molNameSpace.GetDefaultFolder(olFolderInbox).Folders.Item("ProcessedEmails")
On Error GoTo Stop_Crash

iCount = molItems.Count
For i = 1 To iCount
If iCount = 0 Or IsNull(iCount) Then
rst.Close
Forms!Main.TimerInterval = 20000
DoCmd.Close acForm, "Automated", acSaveYes
Else
'For Each iCount In molItems
On Error Resume Next
If TypeName(molItems(i)) = "MailItem" Then
On Error GoTo Stop_Crash
mycount = i
mylastvendor = ""
Me.Repaint
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from tmpTextLine"
DoCmd.SetWarnings True
Set molMail = molItems(i)
If molMail.SenderName Like "Store" & "*" And molMail.Body Like "*" & "Qty" & "*" And molMail.Body Like "*" & "Description" & "*" And molMail.Body Like "*" & "Date" & "*" And molMail.Body Like "*" & "Shop" & "*" Then
....

 

[jedraw]

Not sure what exactly you're trying to od, but if the order of the emails is an issue, why not sort on Received date either in Access or Outlook?

 

[Remou]

Here are a few notes on various ways of sorting, retrieving and limiting Outlook mail items.

Dim oApp As Outlook.Application
Dim oNS As NameSpace
Dim oRecItems As Outlook.MAPIFolder
Dim itm As Outlook.MailItem
Dim oFilterRecItems As Items
Dim strFilter As String
Dim dteLastCheck As Date
Dim dteThisCheck As Date


Set oApp = CreateObject("Outlook.Application")
Set oNS = oApp.GetNamespace("MAPI")


'Sorting
Set oRecItems = oNS.GetDefaultFolder(olFolderInbox)
oRecItems.Items.Sort "[SentOn]", True

For i = 1 To oRecItems.Items.Count
    Debug.Print oRecItems.Items(i).ReceivedTime
Next


'GetFirst, GetLast
Set itm = oRecItems.Items.GetFirst
Debug.Print itm.SentOn
Debug.Print itm.ReceivedTime

Set itm = oRecItems.Items.GetLast
Debug.Print itm.SentOn
Debug.Print itm.ReceivedTime


'Filtering
dteLastCheck = DateAdd("d", -30, Now())
dteThisCheck = Now()

'The format will depend on your locale
strFilter = "[ReceivedTime] > " _
          & Chr(34) & Format(dteLastCheck, "dd/mm/yyyy hh:nn") & Chr(34) _
          & " AND [ReceivedTime] < " _
          & Chr(34) & Format(dteThisCheck, "dd/mm/yyyy hh:nn") & Chr(34)

Set oFilterRecItems = oRecItems.Items.Restrict(strFilter)

http://lessthandot.com

 

[OrbitMascot]

Thank you for the suggestions.

The Get Last code worked perfectly.