Forum des VBA-Tutorials

E-Mails in Excel für bestimmten Zeitraum auslesen (VBA)

ElTobi, Samstag, 01.12.2018, 14:58 (vor 83 Tagen)
bearbeitet von Martin Asal, Sonntag, 02.12.2018, 14:30

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