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 
'https://stackoverflow.com/questions/37060954/trouble-setting-the-subfolder 
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中