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


On Error GoTo 0

End Sub