E-Mails in Excel für bestimmten Zeitraum auslesen (VBA)
Hallo zusammen,
komme leider nicht weiter ... hoffe mir kann jemand helfen
Situation:
Mit diesem Code will ich sämtliche E-Mails eines Funktionspostfaches in eine Excel auslesen lassen.
Problemstellung:
Folgender Code funktioniert - nun würde ich aber gerne nur E-Mails auflisten lassen die innerhalb der Datumsabfrage liegen.
Leider habe ich keine Ahnung wie ich dies in den bestehenden Code einbinden soll.
[Das Postfach dreht noch weitere Schleifen über diverse Unterordner]
Hat jemand eine Idee?
Option Explicit Public Sub ReadMailItems() Dim olapp As Object Dim olName As Object Dim olHFolder As Object Dim olUFolder As Object Dim olUFolder2 As Object Dim strAttCount As String Dim olItemsCount As Long Dim lngAttCount As Long Dim letzteZeile As Long Dim VonDatum As Date, BisDatum As Date On Error Resume Next Set olapp = CreateObject("Outlook.Application") Set olName = olapp.GetNamespace("MAPI") Set olHFolder = olName.Session.Folders("FUNKTIONSPOSTFACH") Set olUFolder = olHFolder.Folders("Posteingang") Set olUFolder2 = olHFolder.Folders("1.01 in Bearbeitung") [A1].Value = "E-Mail-Ordner" [B1].Value = "MailFrom" [C1].Value = "Exchange ID" [D1].Value = "Datum//Uhrzeit" [E1].Value = "Betreff" [F1].Value = "Text" [G1].Value = "Anzahl Datei-Anhang" [H1].Value = "Datei-Anhang" [I1].Value = "Datei-Größe" [J1].Value = "CC" [K1].Value = "Empfänger" Rows(1).Font.Bold = True VonDatum = InputBox("Bitte Datum des ersten zu betrachtenden Tages eingeben:", "Datumseingabe", Format(Now - 1, "DD.MM.YYYY")) BisDatum = InputBox("Bitte Datum des letzten zu betrachtenden Tages eingeben:", "Datumseingabe", Format(Now, "DD.MM.YYYY 23:59:59")) For olItemsCount = 1 To olUFolder.Items.Count With olUFolder.Items.Item(olItemsCount) For lngAttCount = 1 To .Attachments.Count If strAttCount = "" Then strAttCount = .Attachments.Item(lngAttCount).Filename Else strAttCount = strAttCount & vbCrLf & .Attachments.Item(lngAttCount).Filename End If Next lngAttCount Sheets("Master").Range("A" & olItemsCount + letzteZeile).Value = olHFolder.Name & "->" & olUFolder.Name Sheets("Master").Range("B" & olItemsCount + letzteZeile).Value = .Sender Sheets("Master").Range("C" & olItemsCount + letzteZeile).Value = .SenderEmailAddress Sheets("Master").Range("D" & olItemsCount + letzteZeile).Value = .ReceivedTime Sheets("Master").Range("E" & olItemsCount + letzteZeile).Value = .Subject Sheets("Master").Range("F" & olItemsCount + letzteZeile).Value = .body Sheets("Master").Range("G" & olItemsCount + letzteZeile).Value = .Attachments.Count Sheets("Master").Range("H" & olItemsCount + letzteZeile).Value = strAttCount Sheets("Master").Range("I" & olItemsCount + letzteZeile).Value = .Size Sheets("Master").Range("J" & olItemsCount + letzteZeile).Value = .cc Sheets("Master").Range("K" & olItemsCount + letzteZeile).Value = .To strAttCount = "" End With Next olItemsCount letzteZeile = Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row For olItemsCount = 1 To olUFolder2.Items.Count With olUFolder2.Items.Item(olItemsCount) For lngAttCount = 1 To .Attachments.Count If strAttCount = "" Then strAttCount = .Attachments.Item(lngAttCount).Filename Else strAttCount = strAttCount & vbCrLf & .Attachments.Item(lngAttCount).Filename End If Next lngAttCount Sheets("Master").Range("A" & olItemsCount + letzteZeile).Value = olHFolder.Name & "->" & olUFolder2.Name .... End With Next olItemsCount On Error GoTo 0 End Sub
gesamter Thread:
- E-Mails in Excel für bestimmten Zeitraum auslesen -
ElTobi,
01.12.2018, 14:58
- E-Mails in Excel für bestimmten Zeitraum auslesen - Martin Asal, 02.12.2018, 14:43