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
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