将项目作为MailItem处理

Posted 2021-05-03

我正在Outlook 2016中创建一个VBA应用程序。它分析传入的电子邮件并使其主题行搜索重复（或接近重复）主题行。我使用for-each循环来浏览项目列表（这是收件箱中的电子邮件）并分析每个项目的标准。

一旦需要响应，传入的电子邮件和重复的电子邮件都会被标记，以表明我已经回复了它们。

我知道Item和olItem都应该是Item对象。我遇到的问题是：

If InStr(1, GetPreceedingSubject(olItem.Subject), GetPreceedingSubject(SubjectString)) <> 0 _
                And olItem.FlagRequest <> "Follow up" Then

它给了我错误

“运行时错误'438'：对象不支持此属性或方法”

我知道它是olItem，因为它是我在收到错误之前改变的函数的唯一部分。这让我感到奇怪，因为以下片段仍然有用：

' flag both the emails that prompted the response
                    With Item
                        ' due this week flag
                        .MarkAsTask olMarkThisWeek
                        ' sets a specific due date
                        .TaskDueDate = Now + 3
                        .FlagRequest = "Follow up"
                        .FlagStatus = 2
                        .ReminderSet = False
                        .Save
                    End With
                    With olItem
                        ' due this week flag
                        .MarkAsTask olMarkThisWeek
                        ' sets a specific due date
                        .TaskDueDate = Now + 3
                        .FlagRequest = "Follow up"
                        .FlagStatus = 2
                        .ReminderSet = False
                        .Save
                    End With

因此，在第一个代码片段中，它似乎将olItem视为一个对象，但在下一个代码片段中，它允许我将其视为一个MailItem对象。有什么建议？我已经找到了从Item转换为MailItem的方法，即使只是暂时用于那行代码，但显然无济于事。完整的子程序如下：

Private Sub myOlItems_ItemAdd(ByVal Item As Object)
    If ParsingEnabled = False Then
        Exit Sub
    End If

    Dim SubjectString As String     ' tracks the control word to search the subject line for
    Dim pingCount As Integer        ' tracks the number of copies found.
    Dim TimeDiff As Double
    Dim Protocol As Variant
    Dim FlagStatus As Integer

    pingCount = 0
    SubjectString = Item.Subject   ' searches subject line for this word


    ' If the email is a read receipt, then move it to a different folder
    If TypeName(Item) = "ReportItem" Then
        NullPrompt = MoveFolders(Item, "Read")
        If NullPrompt >= 0 Then
            setLblDebug ("Read receipt: " & Mid(SubjectString, 7, Len(SubjectString)))
            Item.UnRead = False
        Else
            NullPrompt = setLblDebug("Error when moving read receipt. Please check inbox and correct", lngRed)
        End If
    End If

    ' Check to make sure it is an Outlook mail message, otherwise
    ' subsequent code will probably fail depending on what type
    ' of item it is.
    If TypeName(Item) = "MailItem" Then
        ' display the message
        setLblDebug ("Incoming Message: " & Item.Subject)
        Item.UnRead = False     ' mark message as read
        ' Iterate through each item of the list
        For Each olItem In myOlItems
            If InStr(1, GetPreceedingSubject(olItem.Subject), GetPreceedingSubject(SubjectString)) <> 0 _
                    And olItem.FlagRequest <> "Follow up" Then
                Protocol = ProtocolCode(Item.Subject)
                If Protocol(0) <> 0 Then
                    ' Time difference between the 2 emails
                    TimeDiff = (Item.ReceivedTime - olItem.ReceivedTime) * 24   ' Gives the hour difference
                    ' If time difference is 0, then it is the same email
                    If Protocol(0) >= TimeDiff And TimeDiff <> 0 Then
                        ' flag both the emails that prompted the response
                        With Item
                            ' due this week flag
                            .MarkAsTask olMarkThisWeek
                            ' sets a specific due date
                            .TaskDueDate = Now + 3
                            .FlagRequest = "Follow up"
                            .FlagStatus = 2
                            .ReminderSet = False
                            .Save
                        End With
                        With olItem
                            ' due this week flag
                            .MarkAsTask olMarkThisWeek
                            ' sets a specific due date
                            .TaskDueDate = Now + 3
                            .FlagRequest = "Follow up"
                            .FlagStatus = 2
                            .ReminderSet = False
                            .Save
                        End With

                        ' email and call if required
                        RenderMail (olItem)
                        If Protocol(1) = 1 Then
                            NullPrompt = RenderCallPrompt(olItem.Subject, Item.ReceivedTime)
                        End If
                        ' set the debug prompt message
                        NullPrompt = setLblDebug("Response Made: " & Item.Subject & " [" & Item.ReceivedTime & "]", lngBlue)
                        If True Then Exit For   ' Reponse made, stop looking for additional emails
                    End If
                End If
            End If
        Next olItem
    End If
End Sub

答案

您不能将不是MailItem的Object视为MailItem。

MailItem是Object的子集。对象包含TaskItem，AppointmentItem等。

其他类型不一定具有MailItem的属性。

在你的代码中：

' Check to make sure it is an Outlook mail message, otherwise
' subsequent code will probably fail depending on what type
' of item it is.
If TypeName(Item) = "MailItem" Then

添加相同的测试以确保olItem是MailItem。

For Each olItem In myOlItems

' Check to make sure it is an Outlook mail message, otherwise
' subsequent code will probably fail depending on what type
' of item it is.

If TypeName(olItem) = "MailItem" Then
'   
End If

Next olItem