Outlook-Monitor Unterordner und Ausführen von Makro

Question

Ich habe Probleme mit einigen Code zu arbeiten. Ich habe es aus dem Code, den ich gefunden habe, zusammengesetzt und bekomme einen Fehler, der besagt, dass das Sub oder die Funktion nicht definiert ist. Ich bin neu in Outlook VBA und kann es nicht herausfinden.

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 

Wenn mir jemand in die richtige Richtung zeigen könnte, wäre das toll.

Answer 1

die Änderungen sehen ich gemacht und vergleichen Sie es mit Ihren

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 

auf Outlook Getestet 2010