Thema Datum  Von Nutzer Rating
Antwort
Rot E-Mails in Excel für bestimmten Zeitraum auslesen
01.12.2018 14:56:02 ElTobi
NotSolved
01.12.2018 15:48:13 ugor
NotSolved
01.12.2018 17:25:37 ElTobi
NotSolved
02.12.2018 12:51:14 Gast55625
NotSolved
02.12.2018 15:28:12 ugor
NotSolved
02.12.2018 23:09:09 ElTobi
NotSolved
02.12.2018 23:10:48 Gast86858
NotSolved
03.12.2018 01:27:08 ugor
NotSolved
03.12.2018 09:26:34 ElTobi
NotSolved
07.12.2018 09:24:26 ElTobi
NotSolved
07.12.2018 14:21:47 ugor
NotSolved
07.12.2018 15:35:31 ElTobi
NotSolved
03.12.2018 07:46:43 Gast2330
NotSolved

Ansicht des Beitrags:
Von:
ElTobi
Datum:
01.12.2018 14:56:02
Views:
65
Rating: Antwort:
  Ja
Thema:
E-Mails in Excel für bestimmten Zeitraum auslesen
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
                 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

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst genau und ausführlich
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
  • Bitte markieren Sie Ihre Anfrage als erledigt wenn Ihnen geholfen wurde
Thema: Name: Email:

 
 

Thema Datum  Von Nutzer Rating
Antwort
Rot E-Mails in Excel für bestimmten Zeitraum auslesen
01.12.2018 14:56:02 ElTobi
NotSolved
01.12.2018 15:48:13 ugor
NotSolved
01.12.2018 17:25:37 ElTobi
NotSolved
02.12.2018 12:51:14 Gast55625
NotSolved
02.12.2018 15:28:12 ugor
NotSolved
02.12.2018 23:09:09 ElTobi
NotSolved
02.12.2018 23:10:48 Gast86858
NotSolved
03.12.2018 01:27:08 ugor
NotSolved
03.12.2018 09:26:34 ElTobi
NotSolved
07.12.2018 09:24:26 ElTobi
NotSolved
07.12.2018 14:21:47 ugor
NotSolved
07.12.2018 15:35:31 ElTobi
NotSolved
03.12.2018 07:46:43 Gast2330
NotSolved