确定邮件是否已被回复

时间:2013-10-15 12:41:08

标签: outlook-2010 outlook-vba

我正在尝试查找特定邮件是否已被回复。

我在网上找到了代码,但它使用的是不在Outlook 2010中的CDO库。

VBA是否等同于:

Sub ShowVerbText()
    Dim objItem As Object
    Dim cdoSession As MAPI.Session
    Dim cdoMessage As MAPI.Message
    Dim cdoField As MAPI.Field
    Dim objFolder As Outlook.MAPIFolder
    Dim strEntryID As String
    Dim strStoreID As String
    Const cdoPR_LAST_VERB_EXECUTED = &H10810003
    Const cdoPR_LAST_VERB_EXECUTION_TIME = &H10820040
    Dim strLastVerb As String
    Dim intLastVerb As Integer
    Dim dteLastVerbTime As Date
    Dim strLastVerbTime As String
    On Error Resume Next

    ' GetCurrentItem function is available at
    ' http://www.outlookcode.com/codedetail.aspx?id=50
    Set objItem = GetCurrentItem()
    If objItem.Class = olMail Then
        If objItem.Sent = True Then
            ' get EntryID and StoreID from item
            Set objFolder = objItem.Parent
            strEntryID = objItem.EntryID
            strStoreID = objFolder.StoreID
            ' initiate CDO session
            Set cdoSession = CreateObject("MAPI.Session")
            cdoSession.Logon "", "", False, False
            ' get same item as CDO Message
            Set cdoMessage = cdoSession.GetMessage(strEntryID, strStoreID)
            Set cdoField = cdoMessage.Fields(cdoPR_LAST_VERB_EXECUTED)
            If Not cdoField Is Nothing Then
                intLastVerb = cdoField.Value
                strLastVerb = LastVerbText(intLastVerb)
                Set cdoField = cdoMessage.Fields(cdoPR_LAST_VERB_EXECUTION_TIME)
                If Not cdoField Is Nothing Then
                    dteLastVerbTime = cdoField.Value
                    strLastVerbTime = FormatDateTime(dteLastVerbTime, vbGeneralDate)
                End If
            Else
                strLastVerb = "No reply or forward"
            End If

            MsgBox strLastVerb & vbCrLf & strLastVerbTime
        End If
    End If

    cdoSession.Logoff
    Set cdoSession = Nothing
    Set cdoMessage = Nothing
    Set cdoField = Nothing
    Set objFolder = Nothing
    Set objItem = Nothing
End Sub

Function LastVerbText(intVerb As Integer)
    ' REFERENCE: http://doc.ddart.net/msdn/header/include/exchform.h.html
    Select Case intVerb
        Case 102
            LastVerbText = "Reply to Sender"
        Case 103
            LastVerbText = "Reply to All"
        Case 104
            LastVerbText = "Forward"
        Case 108
            LastVerbText = "Reply to Forward"
        Case Else
            LastVerbText = "Verb not in list. " & vbCrLf & vbCrLf & _
                "See http://doc.ddart.net/msdn/header/include/exchform.h.html"
    End Select
End Function

1 个答案:

答案 0 :(得分:0)

不使用Message.Fields [],而是使用MailItem.PropertyAccessor.GetProperty

intLastVerb = objItem.PropertyAccessor.getProperty("http://schemas.microsoft.com/mapi/proptag/0x10810003")

要查看DALS属性名称,请查看带有OutlookSpy的消息:单击IMessage,选择有问题的属性,请参阅DASL编辑框。