如何在移动电子邮件时将Outlook电子邮件唯一标识为MailItem.EntryID更改

时间:2015-02-25 23:20:38

标签: vba email outlook

我的公司使用单个电子邮件地址向客户发送请求和订单。我们创建了一个Access数据库,可以将电子邮件导入到表中。该表为每个导入的电子邮件创建了自己的唯一标识符,但不应该导入两次电子邮件。该系统正在运行,因为我们只关注收件箱中的电子邮件,并且不需要更多内容。

然而,我们现在需要了解" flow"," traffic"和"工作量"该帐户所在的电子邮件池。收件箱中的电子邮件被分类,然后移动到名为" my_tasks"的文件夹中。和一个子文件夹,由管理员处理的四个CSR中名为1的文件夹。然后处理此电子邮件,CSR将其移动到另一个名为"已完成"的文件夹下的子文件夹。

因此,电子邮件进入收件箱,移至my_tasks \ joeblow处理并移至Completed \ Canada。

目前我的代码遍历文件夹并查找每封电子邮件,抓取我们要存储的字段,然后将它们插入到表中。所有这些都是通过VBA代码在Access中完成的。

Private Sub ImportEmailItem(objMailItem As Outlook.MailItem)
On Error GoTo ImportEmailItem_Error

    ' Set up DAO objects
    Dim rstMB As DAO.Recordset
    Dim dskippedFolderMailCount As Double
    Dim strSQLrMB As String

    strSQLrMB = "SELECT * FROM tblMailBox WHERE OLID='" & objMailItem.EntryID & "'"

    Set rstMB = CurrentDb.OpenRecordset(strSQLrMB)

        With rstMB
            If Not .BOF And Not .EOF Then

                .MoveLast
                .MoveFirst
                While (Not .EOF)
                    If .Updatable Then
                        .Edit
                            rstMB!Subject = objMailItem.Subject
                            rstMB!Body = objMailItem.Body

                            Call subCategory(objMailItem)

                            rstMB!CSR = IIf(Len(objMailItem.Categories) = 0, "Unassigned", objMailItem.Categories)
                            rstMB!Importance = objMailItem.Importance
                            rstMB!Region = objMailItem.Parent
                            rstMB!DateModified = objMailItem.LastModificationTime
                            rstMB!FlagCompleted = objMailItem.FlagRequest
                            rstMB!folder = objMailItem.Parent
                            rstMB!Path = objMailItem
                        .Update
                    End If
                .MoveNext
                Wend
            Else
                rstMB.AddNew
                    rstMB!olid = objMailItem.EntryID
                    rstMB!ConversationIndex = objMailItem.ConversationIndex
                    rstMB!ConversationID = objMailItem.ConversationID
                    rstMB!Conversation = objMailItem.ConversationTopic
                    rstMB!To = Left(objMailItem.To, 250)
                    rstMB!CC = Left(objMailItem.CC, 250)
                    rstMB!Subject = objMailItem.Subject
                    rstMB!Body = objMailItem.Body

                    Call subCategory(objMailItem)

                    rstMB!CSR = IIf(Len(objMailItem.Categories) = 0, "Unassigned", objMailItem.Categories)
                    rstMB!Importance = objMailItem.Importance
                    rstMB!From = objMailItem.SenderEmailAddress
                    rstMB!Region = objMailItem.Parent
                    rstMB!DateReceived = objMailItem.ReceivedTime
                    rstMB!DateSent = objMailItem.SentOn
                    rstMB!DateCreated = objMailItem.CreationTime
                    rstMB!DateModified = objMailItem.LastModificationTime
                    rstMB!FlagCompleted = objMailItem.FlagRequest
                    rstMB!folder = objMailItem.Parent
                rstMB.Update
            End If
            .Close
        End With

ImportEmailItem_Exit:
    Set rstMB = Nothing
    Exit Sub

ImportEmailItem_Error:
    Debug.Print Err.Number & " " & Err.Description

    Select Case Err.Number
        Case 91
            Resume Next
        Case 3022
            Resume Next
        Case -2147221233
            MsgBox "Customer Care Account Name is incorrect, please enter the Mail box name as seen in your outlook client.", vbOKOnly, "Mail Folder Name Error"
            Me.txtMailAccountName.SetFocus
            Exit Sub
        Case Else
            MsgBox "Error #: " & Err.Number & "  " & Err.Description '& Chr(13) + Chr(10) & IIf(mail.Subject Is Null, "", mail.Subject) & " " & IIf(mail.ReceivedTime Is Null, "", mail.ReceivedTime)
'            DoCmd.RunSQL "INSERT INTO tblImportReport(ImportDate,ImportFolder,ImportResult,ImportEmailCount) VALUES (#" & Now() & "#,'" & mailFolder & "', 'Error " & Err.Number & "', " & dMailCount & ")"
            Resume Next 'cmdImportEmail_Exit
    End Select

End Sub

是否可以使用单个字段唯一标识电子邮件,无论其是否已被移动?

我知道我可以做些什么来确保我有正确的电子邮件并在我的数据库中获取原始条目。如果没有其他方法,我可以将字段连接在一起形成一个唯一字段,然后获取数据库表的主键字段值。

3 个答案:

答案 0 :(得分:2)

您可以使用PR_SEARCH_KEY属性(DASL名称http://schemas.microsoft.com/mapi/proptag/0x300B0102) - 移动邮件时不会更改。它可以通过MailItem.PropertyAccessor.GetProperty访问,但遗憾的是你不能在Items.Find / Restrict中使用PT_BINARY属性。

您还可以使用MailItem.UserProperties设置自己的命名属性。

更新:

对于PR_SEARCH_KEY,请参阅https://msdn.microsoft.com/en-us/library/office/cc815908.aspx

MaillItem.UserProperties可以在任何地方使用 - Outlook对象模型是Outlook对象模型,无论是从Outlook内部使用还是从Excel外部使用。请记住,设置用户属性并使项目失效将更改其上次修改日期。

如果您想坚持PR_SEARCH_KEY,为了能够对其进行排序,您可能需要查看Redemption - 其RDOFolder.Items。查找/限制方法允许在其查询中使用PT_BINARY属性,例如"http://schemas.microsoft.com/mapi/proptag/0x300B0102" = '89F75D48972B384EB2C50266D1541099'

答案 1 :(得分:0)

以下是在MS Access 2013中测试的VBA代码,用于从Outlook.MailItem中提取PR_SEARCH_KEY并转换为字符串:

Public Function strGetMailItemUniqueId( _
    olMailItem As Outlook.MailItem _
) As String
    Dim PR_SEARCH_KEY As String
    PR_SEARCH_KEY = "http://schemas.microsoft.com/mapi/proptag/0x300B0102"

    Dim olPA As Outlook.PropertyAccessor
    Set olPA = olMailItem.PropertyAccessor

    Dim vBinary As Variant
    vBinary = olPA.GetProperty(PR_SEARCH_KEY)

    strGetMailItemUniqueId = olPA.BinaryToString(vBinary)
End Function

答案 2 :(得分:0)

在Microsoft Outlook版本(例如2007、2010,Office 365等)中,电子邮件的标头部分中包含属性Message-ID

您可以使用此属性来唯一标识电子邮件。

enter image description here