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中