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, 365 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

Outlook 2010: Unterordner von Funktionspostfächern auf Neue Nachrichten überwachen (per VBA)

gelöst Frage von ArcanonXXLVB for Applications8 Kommentare

Hallo zusammen, ich hoffe ihr könnt mir helfen. Ich habe ein großes Funktionspostfach, in dem mehrere Unterordner vorhanden sind. ...

Microsoft Office

Unterordner durchsuchen Excel VBA

Frage von schwalbepilotMicrosoft Office1 Kommentar

Hi, ich habe mir ein Makro gebastelt, mit dem ich Daten aus mehreren Word Tabellen auslesen kann. Das Makro ...

VB for Applications

Excel VBA an PDF Formular anpassen

gelöst Frage von Detel1VB for Applications3 Kommentare

Hallo! Ich habe ein PDF Formular das aus Excel VBA beschrieben wird, per email versandt und per outlook zurueck ...

Microsoft Office

VBA zum auslesen von einem Zellbereich Excel

gelöst Frage von schwalbepilotMicrosoft Office1 Kommentar

Hallo, leider bin ich mit Makros noch nicht su vertraut. Ich habe in einen Ordner mehrere hunderte Datein. Alles ...

Neue Wissensbeiträge
Erkennung und -Abwehr
Trendmicro WFBS 10 ist in deutsch verfügbar!
Tipp von VGem-e vor 2 StundenErkennung und -Abwehr

Servus Kollegen, downloadbar unter Gruß

Windows Update

MS Patchday Juni 2018 - BSOD, obwohl noch kein Patch freigegeben

Erfahrungsbericht von diemilz vor 3 StundenWindows Update1 Kommentar

Hallo zusammen, wir hatten hier letzte Woche ein massives Problem. Alles begann damit, dass ein Mitarbeiter kurz vor Feierabend ...

Microsoft
Shadow Defender
Tipp von Hyrule vor 14 StundenMicrosoft

Ich denke viele kennen es: Ein Update oder ein neues Programm und vieles funktioniert nicht mehr wie gewünscht. Die ...

Microsoft
Microsoft verarztet 50 Sicherheitslücken
Tipp von Hyrule vor 4 TagenMicrosoft

Microsoft verarztet mal wieder ein "paar" Sicherheitslücken in ihren Produkten: Und mal wieder Remote Code Execution und der abartige ...

Heiß diskutierte Inhalte
CPU, RAM, Mainboards
ASUS P5W DELUXE startet nur manchmal und nur mit 2 GraKas
Frage von Windows10GegnerCPU, RAM, Mainboards11 Kommentare

Hallo, ich habe das o.g. Motherboard erhalten. Egal ob C2D 8400, Pentium D 945 oder P4 670, das teil ...

Virtualisierung
Virtuelle Maschinen langsam unabhängig vom Hypervisor
gelöst Frage von HyruleVirtualisierung10 Kommentare

Hallo, ich möchte gerne zwei bis drei virtuelle Maschinen virtualisieren, darauf sollen jeweils Windows 10 und diverse etwas größere ...

Exchange Server
Outlook 2016 fordert ständige Authentifizierung an
gelöst Frage von zeroblue2005Exchange Server8 Kommentare

Hallo Zusammen, ich habe ein kleines Netzwerk erichtet, bei einer Firma, die sich stark verkleinert haben (4 Client). Diese ...

Rechtliche Fragen
Vorlage "private Nutzung dienstlicher Mobiltelefone"
Frage von linos2Rechtliche Fragen8 Kommentare

Hallo zusammen, ich bin auf der Suche nach einer Vorlage für die private Nutzung von dienstlichen Mobiltelefonen. Unsere Firma ...