Hallo zusammen,

hm jetzt funktioniert die Datumsabfrage und es werden nur die E-Mails des jeweiligen Zeitintervalls ausgelesen:

Jetzt bestehen zwei weitere Probleme:

• Es wird nur der erste Unterordner ausgelesen, vor dem 2. wird gestoppt
• und in der Tabelle werden Zeilen freigelassen wenn diese nicht dem Zeitintervall entsprechen.

Weiß jemand einen Rat?

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 olItemsCount2 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 = CDate(InputBox("Bitte Datum des ersten zu betrachtenden Tages eingeben:", "Datumseingabe", Format(Now - 1, "DD.MM.YYYY")))
BisDatum = CDate(InputBox("Bitte Datum des letzten zu betrachtenden Tages eingeben:", "Datumseingabe", Format(Now, "DD.MM.YYYY")))
 
VonDatum = DateSerial(Year(VonDatum), Month(VonDatum), Day(VonDatum))
BisDatum = DateSerial(Year(BisDatum), Month(BisDatum), Day(BisDatum) + 1)

letzteZeile = Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row

   For olItemsCount = 1 To olUFolder.Items.Count
          With olUFolder.Items.Item(olItemsCount)
             
             If VonDatum <= .ReceivedTime And .ReceivedTime < BisDatum Then
             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 = ""
 


   For olItemsCount2 = 1 To olUFolder2.Items.Count
   letzteZeile = Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row
          With olUFolder2.Items.Item(olItemsCount2)
             
             
             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" & olItemsCount2 + letzteZeile).Value = olHFolder.Name & "->" & olUFolder2.Name
                 Sheets("Master").Range("B" & olItemsCount2 + letzteZeile).Value = .Sender
                 Sheets("Master").Range("C" & olItemsCount2 + letzteZeile).Value = .SenderEmailAddress
                 Sheets("Master").Range("D" & olItemsCount2 + letzteZeile).Value = .ReceivedTime
                 Sheets("Master").Range("E" & olItemsCount2 + letzteZeile).Value = .Subject
                 Sheets("Master").Range("F" & olItemsCount2 + letzteZeile).Value = .body
                 Sheets("Master").Range("G" & olItemsCount2 + letzteZeile).Value = .Attachments.Count
                 Sheets("Master").Range("H" & olItemsCount2 + letzteZeile).Value = strAttCount
                 Sheets("Master").Range("I" & olItemsCount2 + letzteZeile).Value = .Size
                 Sheets("Master").Range("J" & olItemsCount2 + letzteZeile).Value = .cc
                 Sheets("Master").Range("K" & olItemsCount2 + letzteZeile).Value = .To
               
                
                 strAttCount = ""

End With

  
    
  
 
  
Next
On Error GoTo 0

End If
End With
Next
End Sub