Office: Anzahl Mails in Outlook auslesen und in Excel einfügen

EarlFred · 14. April 2011

Hallo refe,

Ich möchte keine Titel der Mails übertragen haben
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

das hatte mein 2. Code ´garnicht gemacht. Hast Du ihn nichtmal probiert? Schade.

Einmal schriebst Du was von "Vorwoche", dann wieder aktuelle KW. Ich blicke da echt nur schwer durch.

Habe den Code jetzt wie folgt angepasst: Er durchsucht die Ordner XYZ/EHA, XYZ/EDI usw. einmal NUR den Ordner selbst, dann NUR dessen Unterordner und gibt als Ergebnis jeweils die Zahl der Mails in der VORGEGEBENEN KW zurück (nicht der Vorwoche).

Gespeichert werden die Ergebnisse in den Variablen EHA (NUR der Ordner EHA) und EHASUB (NUR die UNTERordner von EHA). Analog für die anderen 3 Ordner.

Da ich die Datei nicht öffnen kann, weiß ich nicht, wohin mit den Werten - daher die allgemeine Variante. Das Zuordnen der Werte in die Tabelle musst Du noch machen - das sollte aber nun nichtmehr der Hit sein.

Code:

Option Explicit
Sub olauslesen()
Dim olApp As Outlook.Application, blnQuit As Boolean
Dim olFld As MAPIFolder
Dim lngKW As Long

Dim EHA As Long, EDI As Long, EWA As Long, EAV As Long
Dim EHASUB As Long, EDISUB As Long, EWASUB As Long, EAVSUB As Long

On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
blnQuit = True
End If
On Error Resume Next

lngKW = CLng(InputBox("Bitte Kalenderwoche angeben!"))

Set olFld = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("XYZ").Folders("EHA")
EHA = ZähleMails(olFld, lngKW, False)
EHASUB = ZähleMails(olFld, lngKW, True)

Set olFld = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("XYZ").Folders("EDI")
EDI = ZähleMails(olFld, lngKW, False)
EDISUB = ZähleMails(olFld, lngKW, True)

Set olFld = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("XYZ").Folders("EWA")
EWA = ZähleMails(olFld, lngKW, False)
EWASUB = ZähleMails(olFld, lngKW, True)

Set olFld = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("XYZ").Folders("EAV")
EAV = ZähleMails(olFld, lngKW, False)
EAVSUB = ZähleMails(olFld, lngKW, True)

Set olFld = Nothing
If blnQuit Then olApp.Quit
Set olApp = Nothing
End Sub

Function ZähleMails(olFld As MAPIFolder, lngKW As Long, blnSubfolders As Boolean) As Long
Dim olfldSuch As Outlook.MAPIFolder, olMail As Outlook.MailItem
If blnSubfolders Then
For Each olfldSuch In olFld.Folders
For Each olMail In olfldSuch.Items
If TypeOf olMail Is MailItem And DatePart("ww", olMail.SentOn, vbMonday, vbFirstFourDays) = lngKW Then
ZähleMails = ZähleMails + 1
End If
Next olMail
ZähleMails = ZähleMails + ZähleMails(olfldSuch, lngKW, True)
Next olfldSuch
Else
For Each olMail In olFld.Items
If TypeOf olMail Is MailItem And DatePart("ww", olMail.SentOn, vbMonday, vbFirstFourDays) = lngKW Then
ZähleMails = ZähleMails + 1
End If
Next olMail
End If
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Grüße
EarlFred

refe · 17. April 2011

Guten Morgen,

erst mal vielen Dank.

Genau so hab ich mir das Makro vorgestellt =)

Nur so zum Verständnis --> er schaut sich laut Code das Empfangsdatum der Mail an und sieht das es zur eingegebenen KW passt. Also zählt der die Funktion eins hoch (also plus eine Mail).

Leider schreibt er mir (nach Anpassung des Codes wo er was in die Tabelle rein schreiben soll) immer nur 0 rein.

Ich weis schon Glaskugel *ggg* aber ich bastel schon hin und her, aber er zählt die Mails nicht. Sind aber überall welche drin....

Hier mal der angepasste Code

Code:

Private Sub CommandButton4_Click()

Dim olApp As Outlook.Application, blnQuit As Boolean
Dim olFld As MAPIFolder
Dim lngKW As Long

Dim EHA As Long, EDI As Long, EWA As Long, EAV As Long
Dim EHASUB As Long, EDISUB As Long, EWASUB As Long, EAVSUB As Long
Dim Zelle_suchen As String

On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
blnQuit = True
End If
On Error Resume Next

lngKW = CLng(InputBox("Bitte Kalenderwoche angeben!")) 'olFolderInbox

Zelle_suchen = (lngKW + 5)

Set olFld = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("EHA")
EHA = ZähleMails(olFld, lngKW, False)
EHASUB = ZähleMails(olFld, lngKW, True)

Range("C" & Zelle_suchen).Value = EHA
Range("L" & Zelle_suchen).Value = EHASUB

Set olFld = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("EDI")
EDI = ZähleMails(olFld, lngKW, False)
EDISUB = ZähleMails(olFld, lngKW, True)

Range("E" & Zelle_suchen).Value = EDI
Range("M" & Zelle_suchen).Value = EDISUB

Set olFld = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("EAV")
EAV = ZähleMails(olFld, lngKW, False)
EAVSUB = ZähleMails(olFld, lngKW, True)

Range("G" & Zelle_suchen).Value = EAV
Range("N" & Zelle_suchen).Value = EAVSUB

Set olFld = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("EWA")
EWA = ZähleMails(olFld, lngKW, False)
EWASUB = ZähleMails(olFld, lngKW, True)

Range("I" & Zelle_suchen).Value = EWA
Range("O" & Zelle_suchen).Value = EWASUB

Set olFld = Nothing
If blnQuit Then olApp.Quit
Set olApp = Nothing
End Sub

Function ZähleMails(olFld As MAPIFolder, lngKW As Long, blnSubfolders As Boolean) As Long
Dim olfldSuch As Outlook.MAPIFolder, olMail As Outlook.MailItem
If blnSubfolders Then
For Each olfldSuch In olFld.Folders
For Each olMail In olfldSuch.Items
If TypeOf olMail Is MailItem And DatePart("ww", olMail.SentOn, vbMonday, vbFirstFourDays) = lngKW Then
ZähleMails = ZähleMails + 1
End If
Next olMail
ZähleMails = ZähleMails + ZähleMails(olfldSuch, lngKW, True)
Next olfldSuch
Else
For Each olMail In olFld.Items
If TypeOf olMail Is MailItem And DatePart("ww", olMail.SentOn, vbMonday, vbFirstFourDays) = lngKW Then
ZähleMails = ZähleMails + 1
End If
Next olMail
End If
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

EarlFred · 18. April 2011

Hallo refe,

kann verschiedene Gründe haben. Greifst Du Dir die richtigen Ordner? (Die Frage kommt ja nicht zum ersten Mal)

Habe den Code bei mir getestet und er arbeitet tadellos. Keine Ahnung, was Du falsch machst. Richtig erkannt: Keine Glaskugel zur Hand.

Dank Copy&Paste-Teufel hat sich eine Zeile verdoppelt- das 2.
On Error Resume Next
mal bitte ändern in
On Error Goto 0

Grüße
EarlFred

refe · 18. April 2011

Hallo,

der Code funktioniert.....suuuuuuuuuper =)

Danke für deine Geduld und deine Mühen !!!!!!

Office: Anzahl Mails in Outlook auslesen und in Excel einfügen

Anzahl Mails in Outlook auslesen und in Excel einfügen

Anzahl Mails in Outlook auslesen und in Excel einfügen

Anzahl Mails in Outlook auslesen und in Excel einfügen

Anzahl Mails in Outlook auslesen und in Excel einfügen - Similar Threads - Anzahl Mails Outlook

Abfrage: Anzahl von Kriterium >0

Anzahl der Downloads bereitgestellter Dateien anzeigen

Anzahl geantwortete Mails in Outlook auslesen und in Excel einfügen

Office 365 pro Plus Version 1908, links Ordnerbereich Ansicht Anzahl Mails

Bedingte - farbliche - Formatierung der angezeigten Anzahl von Mails

Outlook 2016 Anzahl ungelesener Mails nicht sichtbar

Anzahl ungelesener, neuer Mails anzeigen bei Outlook 2000