Option Compare Database
Private Sub ReadInboxDone()
Dim TempRst As DAO.Recordset
Dim rst As DAO.Recordset
Dim OlApp As Outlook.Application
Dim Inbox As Outlook.MAPIFolder
Dim InboxItems As Outlook.Items
Dim Mailobject As Object
Dim db As DAO.Database
Dim dealer As Integer
On Error GoTo ErrorHandler
DoCmd.RunSQL "Delete * from tbl_outlooktempFinish"
Set db = CurrentDb
Set OlApp = CreateObject("Outlook.Application")
Set Inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
Set TempRst = CurrentDb.OpenRecordset("tbl_OutlookTempFinish", dbOpenSnapshot, dbSeeChanges)
Set InboxItems = Inbox.Items
For Each Mailobject In InboxItems
If Mailobject.UnRead Then
'split fresh and old-replied part in email body.
Position = 0
Do Until (Split(Mailobject.Body, vbCrLf)(Position) <> "")
Position = Position + 1
Loop
'only read the first line of fresh part of an email.
If Split(Mailobject.Body, vbCrLf)(0) Like "*Done*" Or Split(Mailobject.Body, vbCrLf)(0) Like "*Complete*" Or Split(Mailobject.Body, vbCrLf)(0) Like "*repaired*" Then
With TempRst
.AddNew
!Subject = Mailobject.Subject
!Sender = Mailobject.SenderName
!To = Mailobject.To
!Body = Mailobject.Body
!DateSent = Mailobject.SentOn
!DateReceived = Mailobject.ReceivedTime
.Update
Mailobject.UnRead = False
End With
End If
End If
Next
ErrorHandler:
Set OlApp = Nothing
Set Inbox = Nothing
Set InboxItems = Nothing
Set Mailobject = Nothing
Set TempRst = Nothing
End Sub
