Outlook 监视器子文件夹和运行宏

Question

我在获取一些代码时遇到了问题。我从找到的代码中将其组合在一起，并收到一条错误消息，指出未定义 Sub 或 Function。我是 Outlook 的新手 VBA，无法理解。

Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.Items

Private Sub Application_Startup()
Dim objWatchFolder As Outlook.Folder
Set objNS = Application.GetNamespace("MAPI")
'Set the folder and items to watch:
'Set objWatchFolder = objNS.GetDefaultFolder(olFolderInbox)
'Set Inbox = Application.Session.GetDefaultFolder(olFolderInbox)
Set objWatchFolder = objNS.Inbox.Folders.Item("Zip Files")
Set objItems = objWatchFolder.Items
Set objWatchFolder = Nothing
End Sub

Private Sub objItems_ItemAdd(ByVal Item As Object)
Dim oFolder As Folder
Dim Date6months As Date
Dim ItemsOverMonths As Outlook.Items

Dim DateToCheck As String

Date6months = DateAdd("d", 0, Now())
Date6months = Format(Date6months, "mm/dd/yyyy")

Set Inbox = Application.Session.GetDefaultFolder(olFolderInbox)
Set oFolder = Inbox.Folders.Item("Zip Files")

DateToCheck = "[Received] <= """ & Date6months & """"

Set ItemsOverMonths = oFolder.Items.Restrict(DateToCheck)

For i = ItemsOverMonths.Count To 1 Step -1
ItemsOverMonths.Item(i).Delete
Next


Set ItemsOverMonths = Nothing
Set oFolder = Nothing

End Sub

如果有人能指出正确的方向，那就太好了。

Answer 1

查看我所做的更改并与您的进行比较

Option Explicit
Private WithEvents objItems As Outlook.Items

Private Sub Application_Startup()
    Dim objNS As Outlook.NameSpace
    Dim objWatchFolder As Outlook.Folder

    Set objNS = Application.GetNamespace("MAPI")
    Set objWatchFolder = objNS.GetDefaultFolder(olFolderInbox).Folders("Zip Files")

    Set objItems = objWatchFolder.Items
End Sub

Private Sub objItems_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        DeleteOlderThan6months Item
    End If
End Sub
'
Sub DeleteOlderThan6months(ByVal Item As Object)
    '//  Declare variables
    Dim oFolder As Folder
    Dim Date6months As Date
    Dim ItemsOverMonths As Outlook.Items
    Dim DateToCheck As String
    Dim olNs As Outlook.NameSpace
    Dim Inbox  As Outlook.MAPIFolder
    Dim oItem As Object
    Dim i As Long

    '// set your inbox and subfolder
    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set oFolder = Inbox.Folders("Zip Files")

    Date6months = DateAdd("d", -1, Now())
    Date6months = Format(Date6months, "mm/dd/yyyy")

    DateToCheck = "[Received] <= """ & Date6months & """"
    Set ItemsOverMonths = oFolder.Items.Restrict(DateToCheck)

'    // Loop through the Items in the folder backwards
    For i = ItemsOverMonths.Count To 1 Step -1
        Set oItem = ItemsOverMonths.Item(i)
        If TypeOf oItem Is Outlook.MailItem Then
            Debug.Print oItem.Subject
            oItem.Delete
        End If
    Next

    Set ItemsOverMonths = Nothing
    Set oFolder = Nothing

End Sub

在 Outlook 2010 上测试。

Outlook 监视器子文件夹和运行宏

Outlook monitor Subfolder and run Macro

outlook

vba

outlook-2010

Outlook 监视器子文件夹和 运行 宏

Outlook monitor Subfolder and run Macro

outlook

vba

outlook-2010

Outlook 监视器子文件夹和运行宏