Question

我正在尝试建立一个宏，该宏将查看我的已发送邮件，并删除包含“发票”已超过30天的任何邮件。目前，它适用于30天以上的电子邮件，但似乎并未对该主题应用过滤器。我当前正在使用的代码如下

Sub MoveAgedMail()

Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objSourceFolder As Outlook.MAPIFolder
Dim objDestFolder As Outlook.MAPIFolder
Dim objVariant As Variant
Dim lngMovedItems As Long
Dim intCount As Integer
Dim Items As Outlook.Items
Dim Filter As String
Dim intDateDiff As Integer
Dim strDestFolder As String

Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderSentMail)

Set objDestFolder = objNamespace.GetDefaultFolder(olFolderDeletedItems)

Filter = "[Subject] = '%" & "invoice" & "%' And [SenderEmailAddress] = _
'abc @hotmail.com'"

Set Items = objSourceFolder.Items.Restrict(Filter)

For intCount = objSourceFolder.Items.Count To 1 Step -1
    Set objVariant = objSourceFolder.Items.Item(intCount)
    DoEvents
    If objVariant.Class = olMail Then

         intDateDiff = DateDiff("d", objVariant.SentOn, Now)

        If intDateDiff > 30 Then

          objVariant.Move objDestFolder

          'count the # of items moved
           lngMovedItems = lngMovedItems + 1

        End If
    End If
Next

MsgBox "Moved " & lngMovedItems & " messages(s)."
Set objDestFolder = Nothing
End Sub

Answer 1

您必须使用一组受限的项目，而不是获取新的项目集合，例如：

 For intCount = objSourceFolder.Items.Count To 1 Step -1
   Set objVariant = objSourceFolder.Items.Item(intCount)

应将其重写为以下内容：

 For intCount = Items.Count To 1 Step -1
   Set objVariant = Items.Item(intCount)

您可能会发现以下文章有帮助：

How To: Use Restrict method to retrieve Outlook mail items from a folder
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)

Answer 2

请勿将Items用作变量。

Sub MoveAgedMail()

'Dim objOutlook As Outlook.Application

'Dim objNamespace As Outlook.NameSpace
Dim objNamespace As NameSpace

'Dim objSourceFolder As Outlook.MAPIFolder
Dim objSourceFolder As Folder

'Dim objDestFolder As Outlook.MAPIFolder
Dim objDestFolder As Folder

Dim objVariant As Variant
Dim lngMovedItems As Long
Dim intCount As Integer

'Dim Items As Outlook.Items ' Do not use Items as a variable
Dim resItems As Items

Dim Filter As String
Dim intDateDiff As Integer
Dim strDestFolder As String

'Set objOutlook = Application   ' not necessary
'Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objNamespace = GetNamespace("MAPI")

Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderSentMail)
Debug.Print "objSourceFolder.Items.Count: " & objSourceFolder.Items.Count

Set objDestFolder = objNamespace.GetDefaultFolder(olFolderDeletedItems)

' ?
Filter = "[Subject] = '%" & "invoice" & "%' And [SenderEmailAddress] =" 'abc @hotmail.com'"
Debug.Print Filter

Filter = "[Subject] = '%" & "invoice" & "%'"
Debug.Print Filter

Set resItems = objSourceFolder.Items.Restrict(Filter)
Debug.Print "objSourceFolder.Items.Count: " & objSourceFolder.Items.Count
Debug.Print "resItems.Count: " & resItems.Count

'For intCount = objSourceFolder.Items.Count To 1 Step -1
For intCount = resItems.Count To 1 Step -1

    Set objVariant = resItems.Item(intCount)

    DoEvents

    If objVariant.Class = olMail Then

        intDateDiff = DateDiff("d", objVariant.SentOn, Now)

        If intDateDiff > 30 Then

            objVariant.Move objDestFolder

            'count the # of items moved
            lngMovedItems = lngMovedItems + 1

        End If
    End If
Next

MsgBox "Moved " & lngMovedItems & " messages(s)."
Set objDestFolder = Nothing
End Sub

为什么当前代码的过滤器未应用于邮件的问题

2 个答案: