Outlook Ordnerliste + Anzahl Elemente / Mails
23.12.2007 10:38:00
stefan
mit folgendem Makro lese ich die "Ordnerstruktur" sämtlicher geöffneter Outlook-Ordner
(Ordern inkl. Unterordner) strukturiert in eine Excel-Datei (Outlook 2003).
Das Makro funktioniert prima !
Jetzt möchte ich dieses Makro gerne so ergänzen, dass mir ebenfalls
(z.b. in die Zelle neben dem Ordernnamen) die Anzahl der jeweiligen Mails / Elemente ausgelesen werden.
Dazu habe ich hier bei Herber auch ein Makro gefunden, dass dieses Zählen
zumindest für den normalen "Posteingang" durchführt.
Kann man diese beiden Makros für alle Ordern / Unterordner entsprechend miteinander kombinieren?
Würd mich sehr freuen, wenn jemand einen Tip hat.
Im voraus allerbesten vorweihnachtlichen Dank
Gruss Stefan
hier nun die Makros:
1. Ordnerliste aus Outlook auslesen
Option Explicit
Private Const STARTZELLE = "A1"
Private Const TBL = "Tabelle1"
Sub schreibe_Ordnerliste()
Dim Ol, Mf, Mf1, mf2, Ns, mf3, i&
Dim Tb As Worksheet
On Error Resume Next
i = Range(STARTZELLE).Row
Set Ol = CreateObject("Outlook.Application")
Set Ns = Ol.GetNamespace("MAPI")
Set Tb = Sheets(TBL): Tb.Cells.ClearContents
For Each Mf In Ns.Folders
Tb.Cells(i, 1).Value = Mf.Name: i = i + 1
For Each Mf1 In Mf.Folders
Tb.Cells(i, 2).Value = Mf1.Name: i = i + 1
For Each mf2 In Mf1.Folders
Tb.Cells(i, 3).Value = mf2.Name: i = i + 1
For Each mf3 In mf2.Folders
Tb.Cells(i, 4).Value = mf3.Name: i = i + 1
Next
Next
Next
Next
Set Ns = Nothing: Set Mf1 = Nothing: Set Mf = Nothing: Set Ol = Nothing: Set Tb = Nothing
Set mf2 = Nothing: Set mf3 = Nothing
End Sub
2. Anzahl Mails / Elemente auslesen (angepasst aus ursprungsquelle herber.de)
Problem: Aus dem Outlook-Pfad "Persönliche Ordner/ Posteingang" soll die Anzahl der Emails ermittelt werden.
Sub GrapText()
Dim objOutlook As Object
Dim objnSpace As Object
Dim objFolder As Object
Dim GrapText As Long
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
Set objFolder = objnSpace.Folders("Postfach - Nachname, Vorname").Folders("Posteingang") ' _
entsprechend anpassen auf den jeweils aktuellen Ordern / Unterordner
GrapText = objFolder.Items.Count
MsgBox "Vorhandene Mails: " & GrapText
'statt MsgBox in Zelle neben den jeweiligen Ordner-Namen eintragen
Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing
End Sub