Excel 代码未执行，因为对象不支持筛选器属性

我无法按主题筛选所选邮件项目。 问题是

If TypeOf Items(1) Is Outlook.MailItem And Items(1).Restrict(sFilter) Then

正在触发错误

运行时错误438:对象不支持此属性或方法

步骤：

循环遍历不同主题名称的单元格 在收件箱和Senitem文件夹中搜索所选主题的最新电子邮件，因为有时人们不会回复您的电子邮件。因此，最新的电子邮件在已发送的邮件中，而不是在您的收件箱中 选择最新的电子邮件并回复所有邮件 对于邮件正文，我正在运行另一个函数以获取所需信息。 守则：

Sub AccessInbox6()
'Early binding
    Dim Olook As Outlook.Application ' to access all the libraries of outlook

    Set Olook = New Outlook.Application
    Dim sFilter As String
    Dim sSubject As String


  ' Restrict items and running the loop

    Sheet1.Range("A2").Select

    Do Until ActiveCell.Value = "" 'Using this to loop over multiple cells containing subjects

        sSubject = ActiveCell.Value
        sFilter = "[Subject] = '" & sSubject & "'"


        Dim Items As Outlook.Items
        Set Items = Olook.GetNamespace("MAPI") _
                         .GetDefaultFolder(olFolderInbox).Items 'Checking the inbox

        Dim Items2 As Outlook.Items
        Set Items2 = Olook.GetNamespace("MAPI") _
                         .GetDefaultFolder(olFolderSentMail).Items 'Checking the sent items


        Items.Sort "ReceivedTime", True 'to put them in order by date
        Items2.Sort "ReceivedTime", True 'to put them in order by date or I should use "SentOn"
        'Items2.Sort "SentOn", True


        If Items.Item(1).ReceivedTime > Items2.Item(1).ReceivedTime Then 'Here I am checking which email is latest by date either in inbox or SentItems

            If TypeOf Items(1) Is Outlook.MailItem And Items(1).Restrict(sFilter) Then 'Getting error here - Here I am checking if the "Subject of the email matches with what I have in the excel sheet

                 Debug.Print Items(1).Subject ' Print on Immediate Window

                       With Items(1).ReplyAll
                            .Display
                            .Body = "Dear Someone" & vbNewLine & vbNewLine & GetPSMUpdate2 & vbNewLine & vbNewLine & "Sincerely," & vbNewLine & "XX-"

                            '.Attachments.Add Environ("UserProfile") & "\Desktop\Tracking Sheet.xlsx"

                            .To = "XXX@gmail.com"
                            .Subject = "PSM Report"
                            '.Send
                        End With
                        Else
                          MsgBox "No emails found with Subject:" & vbLf & "'" & sSubject & "'"

            End If


        Else

            If TypeOf Items2(1) Is Outlook.MailItem And Items2(1).Restrict(sFilter) Then

                 Debug.Print Items(1).Subject ' Print on Immediate Window

                       With Items(1).ReplyAll
                            .Display
                            .Body = "Dear Someone" & vbNewLine & vbNewLine & GetPSMUpdate2 & vbNewLine & vbNewLine & "Sincerely," & vbNewLine & "XX-"

                            '.Attachments.Add Environ("UserProfile") & "\Desktop\Tracking Sheet.xlsx"

                            .To = "XXX@gmail.com"
                            .Subject = "PSM Report"
                            '.Send
                        End With
                        Else
                          MsgBox "No emails found with Subject:" & vbLf & "'" & sSubject & "'"

            End If
        End If

        ActiveCell.Offset(1, 0).Select

    Loop

End Sub

---

在变量名中使用Item会导致一些混乱，并且过滤器可能会被分离

Option Explicit

Sub AccessInbox6Fix()

'Early binding
    Dim Olook As outlook.Application
    
    Dim ItemsRaw As outlook.Items
    Dim Items2Raw As outlook.Items
    
    Dim Items As outlook.Items
    Dim Items2 As outlook.Items
    
    Dim sFilter As String
    Dim sSubject As String
    
    Set Olook = New outlook.Application
    
    Sheet1.Range("A2").Select
    
    Do Until ActiveCell.Value = "" ' Loop over cells containing subjects
        
        'Checking the inbox
        Set ItemsRaw = Olook.Session.GetDefaultFolder(olFolderInbox).Items
        Debug.Print "Raw counts"
        Debug.Print " ItemsRaw.Count: " & ItemsRaw.Count
                
        'Checking the sent items
        Set Items2Raw = Olook.Session.GetDefaultFolder(olFolderSentMail).Items 
        Debug.Print " Items2Raw.Count: " & Items2Raw.Count

        sSubject = ActiveCell.Value
        sFilter = "[Subject] = '" & sSubject & "'"
        Debug.Print
        Debug.Print sFilter
        
        Debug.Print "Subject counts"
        Set Items = ItemsRaw.Restrict(sFilter)
        Debug.Print " Items.Count: " & Items.Count
        
        Set Items2 = Items2Raw.Restrict(sFilter)
        Debug.Print " Items2.Count: " & Items2.Count
        
        Items.Sort "SentOn", True
        Items2.Sort "SentOn", True

        If Items.Item(1).ReceivedTime > Items2.Item(1).ReceivedTime Then
            
            If TypeOf Items.Item(1) Is MailItem Then
            
                Debug.Print Items.Item(1).Subject

                With Items.Item(1).ReplyAll
                    .Display
                    .To = "XXX@noplacenowhere.com"
                    .Subject = "PSM Report"
                    '.Send
                End With
                
            Else
                MsgBox "Most recent item is not a mailitem:" & vbLf & "'" & sSubject & "'"

            End If

        Else

            If TypeOf Items2.Item(1) Is outlook.MailItem Then
            
                 Debug.Print Items2.Item(1).Subject ' Print on Immediate Window

                    With Items2.Item(1).ReplyAll
                        .Display
                        .To = "XXX@noplacenowhere.com"
                        .Subject = "PSM Report"
                        '.Send
                    End With
                    
                Else
                    MsgBox "Most recent item is not a mailitem:" & vbLf & "'" & sSubject & "'"
                    
            End If
            
        End If

        ActiveCell.Offset(1, 0).Select

    Loop
    
    Debug.Print "Done."
    
End Sub

---

在变量名中使用Item会导致一些混乱，并且过滤器可能会被分离

Option Explicit

Sub AccessInbox6Fix()

'Early binding
    Dim Olook As outlook.Application
    
    Dim ItemsRaw As outlook.Items
    Dim Items2Raw As outlook.Items
    
    Dim Items As outlook.Items
    Dim Items2 As outlook.Items
    
    Dim sFilter As String
    Dim sSubject As String
    
    Set Olook = New outlook.Application
    
    Sheet1.Range("A2").Select
    
    Do Until ActiveCell.Value = "" ' Loop over cells containing subjects
        
        'Checking the inbox
        Set ItemsRaw = Olook.Session.GetDefaultFolder(olFolderInbox).Items
        Debug.Print "Raw counts"
        Debug.Print " ItemsRaw.Count: " & ItemsRaw.Count
                
        'Checking the sent items
        Set Items2Raw = Olook.Session.GetDefaultFolder(olFolderSentMail).Items 
        Debug.Print " Items2Raw.Count: " & Items2Raw.Count

        sSubject = ActiveCell.Value
        sFilter = "[Subject] = '" & sSubject & "'"
        Debug.Print
        Debug.Print sFilter
        
        Debug.Print "Subject counts"
        Set Items = ItemsRaw.Restrict(sFilter)
        Debug.Print " Items.Count: " & Items.Count
        
        Set Items2 = Items2Raw.Restrict(sFilter)
        Debug.Print " Items2.Count: " & Items2.Count
        
        Items.Sort "SentOn", True
        Items2.Sort "SentOn", True

        If Items.Item(1).ReceivedTime > Items2.Item(1).ReceivedTime Then
            
            If TypeOf Items.Item(1) Is MailItem Then
            
                Debug.Print Items.Item(1).Subject

                With Items.Item(1).ReplyAll
                    .Display
                    .To = "XXX@noplacenowhere.com"
                    .Subject = "PSM Report"
                    '.Send
                End With
                
            Else
                MsgBox "Most recent item is not a mailitem:" & vbLf & "'" & sSubject & "'"

            End If

        Else

            If TypeOf Items2.Item(1) Is outlook.MailItem Then
            
                 Debug.Print Items2.Item(1).Subject ' Print on Immediate Window

                    With Items2.Item(1).ReplyAll
                        .Display
                        .To = "XXX@noplacenowhere.com"
                        .Subject = "PSM Report"
                        '.Send
                    End With
                    
                Else
                    MsgBox "Most recent item is not a mailitem:" & vbLf & "'" & sSubject & "'"
                    
            End If
            
        End If

        ActiveCell.Offset(1, 0).Select

    Loop
    
    Debug.Print "Done."
    
End Sub

---

这只是一个提示，可能与您的问题无关，Str是一个内置的VBA函数，所以您应该避免将其用作变量名。感谢@Cindymister的提醒。实际上，这段代码是基于Om3r、bigben和Comitern的逻辑构建的，他们建议创建一个新问题。我不知道如何将它们包括在内。他们是更优秀的专家。。。因为Excel在发布的代码中使用，所以我在问题中添加了Excel标记，这样他们可能会看到共产国际已经有了Excel标记。请记住，并不是每个人都知道所有事情，所以可能是同一个人无法回答以前可能/曾经回答过的问题：-这也是一个问题中只有一个主题的原因。我可以看看您的excel文件的示例/示例吗？@0m3r:共享excel和新代码的方式是什么。我重新编写了这段代码，现在我能够根据收件箱中的主题或发送的邮件找到最新的电子邮件。但是，现在唯一的问题是replyall不起作用。这只是一个提示，可能与您的问题无关，Str是一个内置的VBA函数，因此您应该避免将其用作变量名。感谢@Cindymister及时指出。实际上，这段代码是基于Om3r、bigben和Comitern的逻辑构建的，他们建议创建一个新问题。我不知道如何将它们包括在内。他们是更优秀的专家。。。因为Excel在发布的代码中使用，所以我在问题中添加了Excel标记，这样他们可能会看到共产国际已经有了Excel标记。请记住，并不是每个人都知道所有事情，所以可能是同一个人无法回答以前可能/曾经回答过的问题：-这也是一个问题中只有一个主题的原因。我可以看看您的excel文件的示例/示例吗？@0m3r:共享excel和新代码的方式是什么。我重新编写了这段代码，现在我能够根据收件箱中的主题或发送的邮件找到最新的电子邮件。然而，现在唯一的问题是replyll不起作用。