Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

VBA Excel - Outlook Mails auslesen inkl. Unterordner eines Funktionspostfaches - Script anpassen

Mitglied: kaiuwe28

kaiuwe28 (Level 1) - Jetzt verbinden

13.06.2018 um 13:06 Uhr, 1757 Aufrufe, 6 Kommentare, 3 Danke

Hallo zusammen,

ich finde leider mal wieder nicht die Lösung und würde mich freuen, wenn mir einer auf die Sprünge hilft.

Es soll per Excel VBA eine Outlook Funktionspostfach ausgelesen werden. Es sollen alle Ordner ausgelesen werden, also teilweise bis zu 5 Unterordner.
Das vorhandene Script macht aktuell 2 Punkte nicht:

1. Unterordner automatisch auslesen
2. den Ordner wiedergeben inkl. Unterordner, wo die Mail liegt in Spalte C - beginnend ab C2

Bitte helft mir

Danke Jens

01.

02.
Sub Outlook_Mail_auslesen()
03.

04.
'Globale Fehlerbehandlung  -> Excel soll automatisch weitermachen, egal welcher Fehler
05.
On Error Resume Next
06.

07.
'Variablendeklaration
08.
Dim olOrdner As Outlook.MAPIFolder
09.
Dim AnzahlEmail As Integer, i As Integer, Email As Integer, a As Long
10.
Dim VonDatum As Date, BisDatum As Date
11.

12.
Sheets("Maileingang").Select
13.
Cells.Select
14.
Selection.ClearContents
15.

16.
Set olOrdner = GetObject("", "Outlook.Application").GetNamespace("MAPI").Folders("funktionspostfach@arbeit.com").Folders("Inbox").Folders("AAA").Folders("erledigt").Folders("CCC") '.Folders("EEE")
17.

18.
'Setzen der Variable -> es sollen alle Nachrichten im Ordner 'Posteingang (olFolderInbox) gezählt werden
19.
AnzahlEmail = olOrdner.Items.Count
20.

21.
' Überschriften im neuen Blatt  -> die erste Zeile von A1 - C1
22.
[A1].Value = "Betreff"
23.
[B1].Value = "Datum Uhrzeit"
24.
[C1].Value = "Ordner"
25.

26.
'Erste Zeile soll Fett formatiert werden
27.
Rows(1).Font.Bold = True
28.

29.
VonDatum = InputBox("Bitte Datum des ersten zu betrachtenden Tages eingeben:", "Datumseingabe", Format(Now - 1, "DD.MM.YYYY"))
30.
BisDatum = InputBox("Bitte Datum des letzten zu betrachtenden Tages eingeben:", "Datumseingabe", Format(Now, "DD.MM.YYYY  23:59:59"))
31.

32.

33.
'Beginn Schleifendurchlauf (Schleife 1)  -> die Variable 'i' läuft solange, wie Anzahl der EMails vorhanden sind
34.
While i < AnzahlEmail
35.
    i = i + 1
36.
'
37.
    'Anzeigen einer Nachricht in der Statuszeile
38.
    Application.StatusBar = "Lese Posteingang " & _
39.
        Format(i / AnzahlEmail, "0%")
40.
        'Was soll mit den Nachrichten geschehen?  (Schleife 2)
41.
    
42.
        With olOrdner.Items(i)
43.
            'If .ReceivedTime >= VonDatum And .ReceivedTime <= BisDatum Then
44.
                Email = Email + 1
45.
                'Zelle 1 mit dem Wert Betreff in der EMail
46.
                Cells(Email + 1, 1).Value = .Subject
47.
                'Zelle 2 mit dem Wert 'Empfangen am' in der EMail
48.
                Cells(Email + 1, 2).Value = .ReceivedTime
49.
            'End If
50.
        'Ende der Schleife 2
51.
        Debug.Print Email
52.
        End With
53.

54.
    
55.
'Ende der Schleife 1
56.
Wend
57.
 
58.
'Die Objekt-Variable muss wieder geleert werden
59.
Set olOrdner = Nothing
60.

61.
'Die Zelle 'A2' soll selektiert werden
62.
[A2].Select
63.

64.
'Die Exceldatei wird gespeichert
65.
ActiveWorkbook.Saved = True
66.

67.
'Die Statuszeile wird wieder ausgeschaltet
68.
Application.StatusBar = False
69.

70.
End Sub
71.
Mitglied: 136166
13.06.2018, aktualisiert um 13:15 Uhr
Unterordner automatisch auslesen
Mach dir eine Rekursive Funktion die sich selbst für jeden Unterordner aufruft.

Beispiel:
01.
Sub RecurseFolders(ByVal fldr As Folder)
02.
     For Each itm In fldr.items
03.
         ' Mach was mit der Mail
04.
         msgbox itm.Subject
05.
     Next
06.
    'Prozedur ruft sich selbst für alle Unterordner erneut auf
07.
    For Each subfolder In fldr.Folders
08.
        RecurseFolders subfolder
09.
    Next
10.
End Sub
Bitte warten ..
Mitglied: kaiuwe28
13.06.2018 um 14:11 Uhr
Hi decathon,

vielen Dank für deine schnelle Antwort, aber ich bin ganz ehrlich, ich komme mit den Code nicht klar.

1. ich weiß einfach nicht wie ich den einbauen soll z.B. wo kommt mein Funktionspostfach hin
2. wird das Makro nicht angezeigt, erst wenn ich "ByVal fldr As Folder" entferne
3. fehlt in Zeile 8 nicht irgendwas, da hatte VBA auch gemeckert

copy & paste und ein paar kleine Sache schaffe ich ja meistens noch, aber irgendwie fehlt mir hier wieder das nötige Verständnis um das korrekt zu verwenden.

Evtl. hast du ja noch Tipps, wie ich das ggf. einbauen kann.
Bitte warten ..
Mitglied: 136166
13.06.2018, aktualisiert um 23:37 Uhr
War ja wieder klar ...
01.
Sub Outlook_Mail_auslesen()
02.

03.
'Globale Fehlerbehandlung  -> Excel soll automatisch weitermachen, egal welcher Fehler
04.
On Error Resume Next
05.

06.
'Variablendeklaration
07.
Dim olOrdner As Outlook.MAPIFolder
08.
Dim AnzahlEmail As Integer, i As Integer, Email As Integer, a As Long
09.
Dim VonDatum As Date, BisDatum As Date
10.

11.
Sheets("Maileingang").Select
12.
Cells.Select
13.
Selection.ClearContents
14.

15.
Set olOrdner = GetObject("", "Outlook.Application").Session.Stores("funktionspostfach@arbeit.com").GetDefaultFolder(6).Folders("AAA").Folders("erledigt").Folders("CCC") '.Folders("EEE")
16.

17.
'Setzen der Variable -> es sollen alle Nachrichten im Ordner 'Posteingang (olFolderInbox) gezählt werden
18.
AnzahlEmail = olOrdner.Items.Count
19.

20.
' Überschriften im neuen Blatt  -> die erste Zeile von A1 - C1
21.
[A1].Value = "Betreff"
22.
[B1].Value = "Datum Uhrzeit"
23.
[C1].Value = "Ordner"
24.

25.
'Erste Zeile soll Fett formatiert werden
26.
Rows(1).Font.Bold = True
27.

28.
RecurseFolders olOrdner
29.
 
30.
'Die Objekt-Variable muss wieder geleert werden
31.
Set olOrdner = Nothing
32.

33.
'Die Zelle 'A2' soll selektiert werden
34.
[A2].Select
35.

36.
'Die Exceldatei wird gespeichert
37.
ActiveWorkbook.Save
38.

39.
'Die Statuszeile wird wieder ausgeschaltet
40.
Application.StatusBar = False
41.

42.
End Sub
43.

44.
Sub RecurseFolders(ByVal fldr As Object)
45.
     For Each itm In fldr.items
46.
        set n = Cells(Rows.Count,"A").End(xlUp).Offset(1)
47.
        With itm
48.
                n.Resize(1,3).Value = Array(.Subject,.ReceivedTime,fldr.FolderPath)
49.
        End With
50.
     Next
51.
    'Prozedur ruft sich selbst für alle Unterordner erneut auf
52.
    For Each subfolder In fldr.Folders
53.
        RecurseFolders subfolder
54.
    Next
55.
End Sub
Viel Spaß beim lernen ...i'm out
Bitte warten ..
Mitglied: kaiuwe28
13.06.2018 um 15:24 Uhr
Auf jeden Fall schon mal vielen Dank.

Ich versuche es ja auch, aber ich bleibe immer wieder hängen und finde die Fehler nicht.
Ist wie mit Fremdsprachen, der eine bekommt es auf anhieb hin, der andere brauch viel Hilfe.

Hatte vorhin z.B. eine gute Stunde gesucht, aber nicht "FolderPath" gefunden. Hatte es mit nur "Folder" und noch ein paar andere Varianten probiert. Leider ohne Erfolg. Jetzt sehe ich es bei dir und denke mir, ja vollkommen logisch. Vielleicht bin ich auch zum Nutzen von Google nicht geeignet ;)

Was ich noch nicht verstehe ist, wo durch dein Sub weiß, welches Funktionspostfach es abfragen soll. Mir ist der Zusammenhang nicht klar.

Ich nutze VBA nicht oft und wenn du in meine Beträge guckst, dann hat sich das schon etwas gebessert. Ich bereite schon mal was vor, da ich es ja verstehen will. Aber jetzt Schluss mit den Rechtfertigen.

Danke nochmal. Ich probiere das mal und gebe noch mal Feedback.
Bitte warten ..
Mitglied: 136166
13.06.2018, aktualisiert um 16:39 Uhr
Was ich noch nicht verstehe ist, wo durch dein Sub weiß, welches Funktionspostfach es abfragen soll. Mir ist der Zusammenhang nicht klar.
s.o.
01.
Set olOrdner = GetObject("", "Outlook.Application").Session.Stores("funktionspostfach@arbeit.com").GetDefaultFolder(6).Folders("AAA").Folders("erledigt").Folders("CCC") '.Folders("EEE") 
Zum Verständnis der 6 siehe
OlDefaultFolders Enumeration
Bitte warten ..
Mitglied: kaiuwe28
13.06.2018 um 22:56 Uhr
Ich habe es mal probiert, aber es werden nur die Überschriften geschrieben.
Wahrscheinlich habe ich beim Anpassen ein Fehler

01.

02.
Set olOrdner = GetObject("", "Outlook.Application").Session.Stores("funktionspostfach@arbeit.com").GetDefaultFolder(6)
03.
Muss ich hier noch den ersten Ordner benennen?

Des Weiteren hatte ich eine Fehlermeldung bei:

01.

02.
 Set next = Cells(Rows.Count, "A").End(xlUp).Offset(1)
03.
Das next habe ich dann in ein hh geändert, da ich mir dachte, dass VBA dies nicht versteht zwecks for each next Schleife.

Beim Suchen im Internet habe ich noch eine andere Variante gefunden, welche auch super funktioniert, aber hier bekomme ich leider nicht die zeitliche Abgrenzung hinein:

01.

02.
Sub Outlook_Ordnerliste_Count()
03.
   Dim Ol, mf, Mf1, mf2, Ns, mf3, mf4, mf5, mf6, mf7, i&
04.
   Dim Tb As Worksheet
05.
   Dim VonDatum As Date, BisDatum As Date
06.
   
07.
   On Error Resume Next
08.
   i = Range("A1").Row
09.

10.
    VonDatum = InputBox("Bitte Datum des ersten zu betrachtenden Tages eingeben:", "Datumseingabe", Format(Now - 1, "DD.MM.YYYY"))
11.
    BisDatum = InputBox("Bitte Datum des letzten zu betrachtenden Tages eingeben:", "Datumseingabe", Format(Now, "DD.MM.YYYY  23:59:59"))
12.

13.
   Set Ol = CreateObject("Outlook.Application")
14.
   Set Ns = Ol.GetNamespace("MAPI") 'Konto einschränken
15.
   Set Tb = Sheets("Maileingang"): Tb.Cells.ClearContents
16.
   
17.
    
18.
    For Each mf In Ns.Folders
19.
        Tb.Cells(i, 1).Value = mf.Name: i = i + 1
20.
        Tb.Cells(i - 1, 9) = mf.Items.Count
21.
    
22.
        For Each Mf1 In mf.Folders
23.
        If Mf1.Items.ReceivedTime >= VonDatum And Mf1.Items.ReceivedTime <= BisDatum Then
24.
            Tb.Cells(i, 2).Value = Mf1.Name: i = i + 1
25.
            Tb.Cells(i - 1, 9) = Mf1.Items.Count
26.
        End If
27.
        
28.
            For Each mf2 In Mf1.Folders
29.
            If mf2.Items.ReceivedTime >= VonDatum And mf2.Items.ReceivedTime <= BisDatum Then
30.
                Tb.Cells(i, 3).Value = mf2.Name: i = i + 1
31.
                Tb.Cells(i - 1, 9) = mf2.Items.Count
32.
            End If
33.
            
34.
                For Each mf3 In mf2.Folders
35.
                If mf3.Items.ReceivedTime >= VonDatum And mf3.Items.ReceivedTime <= BisDatum Then
36.
                    Tb.Cells(i, 4).Value = mf3.Name: i = i + 1
37.
                    Tb.Cells(i - 1, 9) = mf3.Items.Count
38.
                End If
39.
                
40.
                    For Each mf4 In mf3.Folders
41.
                    If mf4.Items.ReceivedTime >= VonDatum And mf4.Items.ReceivedTime <= BisDatum Then
42.
                        Tb.Cells(i, 5).Value = mf4.Name: i = i + 1
43.
                        Tb.Cells(i - 1, 9) = mf4.Items.Count
44.
                    End If
45.
                    
46.
                        For Each mf5 In mf4.Folders
47.
                        If mf5.Items.ReceivedTime >= VonDatum And mf5.Items.ReceivedTime <= BisDatum Then
48.
                            Tb.Cells(i, 6).Value = mf5.Name: i = i + 1
49.
                            Tb.Cells(i - 1, 9) = mf5.Items.Count
50.
                        End If
51.
                        
52.
                            For Each mf6 In mf5.Folders
53.
                            If mf6.Items.ReceivedTime >= VonDatum And mf6.Items.ReceivedTime <= BisDatum Then
54.
                                Tb.Cells(i, 7).Value = mf6.Name: i = i + 1
55.
                                Tb.Cells(i - 1, 9) = mf6.Items.Count
56.
                            End If
57.
                            
58.
                                For Each mf7 In mf6.Folders
59.
                                If mf7.Items.ReceivedTime >= VonDatum And mf7.Items.ReceivedTime <= BisDatum Then
60.
                                    Tb.Cells(i, 8).Value = mf7.Name: i = i + 1
61.
                                    Tb.Cells(i - 1, 9) = mf7.Items.Count
62.
                                End If
63.
                            Next
64.
                        Next
65.
                    Next
66.
                Next
67.
            Next
68.
         Next
69.
      Next
70.
    Next
71.
    
72.
   Set Ns = Nothing: Set Mf1 = Nothing: Set mf = Nothing: Set Ol = Nothing: Set Tb = Nothing
73.
   Set mf2 = Nothing: Set mf3 = Nothing
74.

75.
End Sub
76.
Leider wird meine If Abfrage nicht berücksichtigt und immer der gesamte Count angegeben. Habe ich da einen Denkfehler oder ist der Count pro Ordner ein fester Wert, den ich gar nicht so abfragen kann?

Vielleicht kannst du mir oder ein anderer noch einen Tip geben.

Das Grundgerüst des Codes habe ich in einem anderen Forum gefunden und wenn es gewünscht ist, dann füge ich auch gern den Link hinzu.

Danke!
Bitte warten ..
Ähnliche Inhalte
VB for Applications
VBA Outlook - Mail delivery system
gelöst Frage von carolin.zeldaVB for Applications5 Kommentare

Hallo zusammen, und zwar habe ich folgendes Problem: Wir arbeiten mit einem Newslettersystem und bekommen sehr oft Emails zurück, ...

VB for Applications

Scriptanpassung VBA mit Outlook-Excel Anhänge versenden

Frage von ChristianKlVB for Applications1 Kommentar

Hallo zusammen, ich bin noch recht frisch in VBA und versuche hier und da hinzuzulernen. Leider kann ich VBA ...

Microsoft Office

Importieren von excel daten in outlook vba

gelöst Frage von BgervaisMicrosoft Office10 Kommentare

Hallo, mein Deutsch ist nicht so gut, aber ich versuche es trotzdem. (Excel und Outlook - Deutsch Sprache) ich ...

Microsoft Office

Excel VBA vbyesno

gelöst Frage von Florian86Microsoft Office2 Kommentare

Hallo, ich habe folgenden Code Sub AbgerundetesRechteck1_Klicken() Dim wksOrig As Worksheet Dim wksStore As Worksheet Dim lngLastRow As Long ...

Neue Wissensbeiträge
Sicherheit
Have i been pwned Datensammlung lokal durchsuchen
Information von sabines vor 5 StundenSicherheit2 Kommentare

Heise beschreibt in diesem Artikel wie man seine eigenen Passwörter prüfen kann. Da viele den Weg der Onlineprüfung scheuen, ...

Windows 10

Windows 10 kann XPS erzeugen aber nicht anzeigen ????

Erfahrungsbericht von Deepsys vor 1 TagWindows 101 Kommentar

Heute schickt mir ein Kollegen eine E-Mail mit einer XPS-Datei vom Kunden im Anhang und fragt wie er diese ...

Exchange Server

1und1 IONOS: Probleme beim Mailversand mit Exchange

Information von reksierp vor 2 TagenExchange Server3 Kommentare

Hallo, seit Do, 17.1.19 etwa Mittags nimmt 1und1 IONOS keine Mails mehr über den Standard-Port SMTP 25 an. Nachdem ...

LAN, WAN, Wireless

Cisco Mikrotik VPN Standort Vernetzung mit dynamischem Routing

Anleitung von aqui vor 2 TagenLAN, WAN, Wireless

1. Allgemeine Einleitung Das nachfolgende Tutorial ist eine Fortführung der hier bei Administrator.de schon bestehenden VPN Tutorials und beschreibt ...

Heiß diskutierte Inhalte
Windows Server
Sicherung Domain Controller
gelöst Frage von Monto1Windows Server22 Kommentare

Hallo zusammen, wie sichert Ihr den Domain Controller? Selbst, wenn zwei parallel laufen, ist eine Sicherung doch mal nützlich. ...

Backup
Was spricht gegen die veeam backup free edition?
Frage von keine-ahnungBackup20 Kommentare

Moin at all, aktuell plane ich die Umstellung meiner sehr überschaubaren Umgebung (3 Büchsen, davon 1 SBS2011 physisch, ein ...

LAN, WAN, Wireless
Wo lässt sich das Gateway in der FRITZ!Box 7360 einstellen?
gelöst Frage von OssabowLAN, WAN, Wireless20 Kommentare

Hallo all, nach gründlicher Suche scheine ich der einzige zu sein der das Problem hat (macht micht schon mal ...

Windows Server
Windows User Freigaben anzeigen lassen
Frage von fritte87Windows Server18 Kommentare

Hallo zusammen, gibt es eine Möglichkeit aus User Sicht anzeigen zu lassen, welche Freigaben er alle besitzt? Wir haben ...