Auflisten aller Emails eines bestimmten Ordners (+ Rekursion)

Wenn man Emails bearbeiten möchte, benötigt man hin und wieder eine Lösung, die über alle Outlook-Elemente eines Ordners (rekursiv) iteriert.

Nachfolgendes Beispiel, wie man rekursiv über alle Ordner inklusive Unterordner alle Email-Betreffs ausgeben kann.

Aufruf:

> call GetListOfEmails(true)

	' Subroutine zum Abrufen einer Liste von E-Mails aus einem bestimmten Outlook-Ordner
	Public Sub GetListOfEmails(Optional bRecursive As Boolean = True)
	Dim myFolder As Outlook.MAPIFolder

	' Einstellen des Posteingangsordners
	Set myFolder = GetFolder("\\xyz@abc.com\Posteingang")

	' Abrufen der Elemente des Hauptordners
	Call GetItemsOfFolder(myFolder)

	' Wenn rekursiv, dann auch die Unterordner durchgehen
	If bRecursive = True Then
	Call GetItemsOfSubFolder(myFolder, bRecursive)
	End If
	End Sub

by GitHub

Die Funktion, die aus einem OrdnerPfad (MAPIFolder.FolderPath) wieder ein Objekt macht, gibt es im Internet.

GetFolder(strFolderPath)

	' Subroutine zum Abrufen von E-Mail-Elementen aus Unterordnern
	Public Sub GetItemsOfSubFolder(MAPIFolder As Outlook.MAPIFolder, Optional bRecursive As Boolean = True)
	Debug.Print "Der Ordner " & MAPIFolder.FolderPath & " enthält " & MAPIFolder.Folders.Count & " Elemente"

	' Durchgeht jeden Unterordner, falls vorhanden
	If MAPIFolder.Folders.Count > 0 Then
	Dim myFolder As Outlook.MAPIFolder
	For Each myFolder In MAPIFolder.Folders
	' Abrufen der Elemente des jeweiligen Unterordners
	Call GetItemsOfFolder(myFolder)

	' Wenn rekursiv, dann weitere Unterordner durchsuchen
	If bRecursive = True Then
	Call GetItemsOfSubFolder(myFolder)
	End If
	Next
	End If
	End Sub

by GitHub

	' Subroutine zum Durchgehen der Elemente in einem bestimmten Ordner
	Public Sub GetItemsOfFolder(MAPIFolder As Outlook.MAPIFolder)
	Dim myEmail As Outlook.MailItem
	Dim myObj As Object

	Debug.Print "Der Ordner " & MAPIFolder.FolderPath & " enthält " & MAPIFolder.Items.Count & " Elemente"

	' Durchgeht jedes Element im Ordner
	For Each myObj In MAPIFolder.Items
	' Prüft, ob es sich um eine E-Mail handelt
	If TypeName(myObj) = "MailItem" Then
	Set myEmail = myObj
	Debug.Print " " & myEmail.Subject
	End If
	Next
	End Sub

by GitHub

	' Funktion zum Abrufen eines Outlook-Ordners nach Pfad
	Public Function GetFolder(strFolderPath As String) As Outlook.MAPIFolder
	' Initialisierung der Variablen
	Dim objApp As Outlook.Application
	Dim objNS As Outlook.NameSpace
	Dim colFolders As Outlook.Folders
	Dim objFolder As Outlook.MAPIFolder
	Dim arrFolders() As String
	Dim i As Long

	On Error Resume Next

	' Bereinigen und Aufteilen des übergebenen Pfades
	strFolderPath = Replace(strFolderPath, "\\", "")
	strFolderPath = Replace(strFolderPath, "/", "\")
	arrFolders() = Split(strFolderPath, "\")

	' Zugriff auf Outlook und dessen Namespace
	Set objApp = Application
	Set objNS = objApp.GetNamespace("MAPI")

	' Durchgehen der Ordnerstruktur
	Set objFolder = objNS.Folders.Item(arrFolders(0))
	If Not objFolder Is Nothing Then
	For i = 1 To UBound(arrFolders)
	Set colFolders = objFolder.Folders
	Set objFolder = Nothing
	Set objFolder = colFolders.Item(arrFolders(i))
	If objFolder Is Nothing Then
	Exit For
	End If
	Next
	End If

	' Rückgabe des gefundenen Ordners
	Set GetFolder = objFolder

	' Aufräumen
	Set colFolders = Nothing
	Set objNS = Nothing
	Set objApp = Nothing
	End Function