Consulting

Results 1 to 1 of 1

Thread: How to find correct recordset and edit it

  1. #1

    How to find correct recordset and edit it

    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
    Last edited by Bob Phillips; 09-18-2017 at 01:05 AM. Reason: Added code tags

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •