将唯一数据下载到ms访问表中

时间:2017-09-07 03:10:41

标签: access-vba

我正在使用此代码将某些Outlook邮件字段下载到访问中。这很好用,但代码继续下载重复的邮件。有没有办法检查现有记录并下载表中没有的记录?您的答案对我的项目有很大帮助     

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 dealer As Integer
Set db = CurrentDb

Set OlApp = CreateObject("Outlook.Application")
Set inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
Set rst= CurrentDb.OpenRecordset("mls")
Set inboxItems = inbox.Items
For Each Mailobject In inboxItems

    With rst
        .AddNew
        !task= Mailobject.UserProperties.Find("taskID")
        !tsktml= Mailobject.UserProperties.Find("timeline")
        .Update

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

1 个答案:

答案 0 :(得分:2)

我假设TaskID是任务的数字唯一标识符,而不是熟悉Outlook对象的数字唯一标识符。如果是这样,您可以使用以下代码首先检查尚未导入的任务。

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 dealer As Integer
    Set db = CurrentDb

    Set OlApp = CreateObject("Outlook.Application")
    Set inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
    Set rst= CurrentDb.OpenRecordset("mls")
    Set inboxItems = inbox.Items
    For Each Mailobject In inboxItems

        With rst
            .FindFirst "task =""" & Mailobject.UserProperties.Find("taskID") & """"
            If .NoMatch
                .AddNew
                !task= Mailobject.UserProperties.Find("taskID")
                !tsktml= Mailobject.UserProperties.Find("timeline")
                .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