如何编辑匹配的记录集?

时间:2017-09-18 03:02:28

标签: access-vba outlook-vba

我使用以下两个代码来下载Outlook邮件,另一个用来更新它。我对第一个下载邮件的代码没有任何问题。但是,当我使用第二个代码来查找任务并对相应的记录集添加一些时,有时错误的记录集会更新,你可以帮我吗? senttime和sentto反映了错误的任务

第一个代码:

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

第二个代码

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

1 个答案:

答案 0 :(得分:1)

您可以添加第二项检查以验证记录是否是您想要的记录。

If Not (var Is Nothing) Then
       With rst 
           .FindFirst "task=" Chr(34) & var & Chr(34)
        If Not .NoMatch  Then
            If !task = CStr(Nz(var))
                .edit
                !senttime= MailObject.Receivedtime
                !sentto = mailobject.to
                .Update

                Mailobject.UnRead = False
            End If
        End If
    End With
End If

请注意,打印或记录未通过!task = CStr(Nz(var))检查的记录可能很有用。我最好的猜测是这些值varNull