Automatisierte Erstellung des Suchordners "Heute erhalten"

Dieses VBA-Makro automatisiert die Einrichtung eines speziellen Suchordners in Microsoft Outlook. Ziel ist es, den manuellen Prozess der Kriterienfestlegung zu umgehen und mit einem Klick einen virtuellen Ordner zu erstellen, der in Echtzeit alle am aktuellen Tag empfangenen E-Mails bündelt. Der Ordner wird im Standardpostfach erstellt wenn es mehrere Accounts in einem Outlookprofil gibt.

So richtest du es ein:
Drücke in Outlook ALT + F11, um den VBA-Editor zu öffnen.

Gehe auf Einfügen -> Modul und kopiere den Code oben hinein.

Wichtig: Ändere in der Zeile Set archiveFolder = objNS.Folders("Archiv") das Wort "Archiv" in den Namen, den deine PST-Datei in der Outlook-Seitenleiste hat.

Speichere und schließe das Fenster.

Du kannst das Makro nun über ALT + F8 starten oder dir einen Button oben in die Menüleiste legen.

Sub CreateTodayReceivedOnlyFolder()
Dim objNamespace As Outlook.NameSpace
Dim objSearch As Outlook.Search
Dim strFilter As String
Dim strScope As String
Dim strFolderName As String

On Error Resume Next
Set objNamespace = Application.GetNamespace("MAPI")

' 1. Name festlegen
strFolderName = "Heute erhalten"

' 2. Scope: Wir durchsuchen das gesamte Postfach
strScope = "'" & objNamespace.GetDefaultFolder(olFolderInbox).Parent.FolderPath & "'"

' 3. Der sicherste Filter für "Heute":
' Wir nutzen die DASL-Syntax mit einem Alias für das heutige Datum.
' Diese Version ist unabhängig von regionalen Datumsformaten (dd.mm vs mm/dd).
strFilter = "urn:schemas:httpmail:datereceived >= 'today'"

' 4. Suche ausführen
' Wir verzichten auf die Prüfung "kein Entwurf", um erst einmal ALLE Mails von heute zu finden
Set objSearch = Application.AdvancedSearch(strScope, strFilter, True, strFolderName)

' 5. Speichern
' Wir fügen eine kleine Pause ein, damit Windows die Variable verarbeiten kann
DoEvents
objSearch.Save (strFolderName)

If Err.Number <> 0 Then
MsgBox "Hinweis: Falls der Ordner nicht erscheint, lösche den alten 'Heute erhalten' manuell und klicke erneut.", vbInformation
Else
MsgBox "Suchordner wurde aktualisiert. Es kann bis zu 30 Sekunden dauern, bis Outlook alle 800+ Mails indiziert hat.", vbInformation
End If
End Sub

Wie du das Makro jetzt benutzt:

Drücke ALT + F8 in Outlook.

Wähle ArchivierenMitAuswahl und klicke auf Ausführen.

Tippe im Fenster die Nummer deines Archivs (z.B. für archiv2026.pst) ein.

Bestätige mit "Ja".