PDA

View Full Version : How to find correct recordset and edit it



Voyager
09-17-2017, 11:49 PM
I am using the below two codes one to download outlook mails and another to update it. I have no issues with the first code which downloads mails. However when I use the second code to find the task and make some additions to the corresponding recordset sometimes wrong recordset is getting updated could you assist me? The senttime and sentto is reflecting for the wrong task

First code:


Private Sub getml()
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 var As variant
Set db = CurrentDb

Set OlApp = CreateObject("Outlook.Application")
Set inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
Set rst= CurrentDb.OpenRecordset("mls")
Set inboxItems = inbox.Items
On error resume next
For Each Mailobject In inboxItems
set var = MailObject.UserProperties.Find("taskID")
IF Not (var Is Nothing) Then
With rst
.FindFirst "task=" Chr(34) & var & Chr(34)
If .NoMatch then
.AddNew
!task= var.value & ""
.Update

Mailobject.UnRead = False
End If
End With
End If
Next
Set OlApp = Nothing
Set inbox = Nothing
Set inboxItems = Nothing
Set Mailobject = Nothing
End sub

Second code


Private Sub stml()
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 var As variant
Set db = CurrentDb

Set OlApp = CreateObject("Outlook.Application")
Set inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderSentMail)
Set rst= CurrentDb.OpenRecordset("mls")
Set inboxItems = inbox.Items
On error resume next
For Each Mailobject In inboxItems
set var = MailObject.UserProperties.Find("taskID")
IF Not (var Is Nothing) Then
With rst
.FindFirst "task=" Chr(34) & var & Chr(34)
If not .NoMatch then
.edit
!senttime= MailObject.Receivedtime
!sentto = mailobject.to
.Update

Mailobject.UnRead = False
End If
End With
End If
Next
Set OlApp = Nothing
Set inbox = Nothing
Set inboxItems = Nothing
Set Mailobject = Nothing
End sub