---

guten Abend

suche eine Möglichkeit um Daten ( die betreff Zeile , Datum,usw. )automatisch von Outlook Richtung Excel zu bekommen in eine sich selbständig erweiternden Excel Tabelle.

meine so in der art, jede stunde werden die neu hinzu gekommenen Emails (Header wenn es so genannt wird ) in eine vorhandenen Excel Tabelle hinzu gefügt 
und selbst könnte ich noch weitere Daten in der neu dazu gekommenen Zeile einfügen.

als access Datenbank geht denke ich auch noch.

sollte schlicht einfach sein. Ein zu kaufende Lösung ist auch kein
Problem Hauptsache ein Ansatzpunkt zur weiteren suche hier oder im Internet

sollte es in Outlook oder Excel eine eingebaute Funktion existieren währe ich dankbar für diese Info

danke und Gruß
dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Was würde den eine Netzsuche ergeben?

Den unteren Schnippsel habe ich von http://www.herber.de/forum/archiv/1084to1088/t1084910.htm

ungetestet - wenn er funktioniert, dann erweitern...

da ich kein Outlook verwende, bin ich auch raus ,)

Code:

---

Option Explicit

'Benötigt den Verweis auf Microsoft Outlook Object Library

Sub MailsImportieren()
Dim objOutlook As Outlook.Application
Dim objnSpace As Namespace
Dim objFolder As MAPIFolder
Dim objMsg As MailItem
Dim LRow As Long
Dim myAr() As Variant
  
   Set objOutlook = New Outlook.Application
   Set objnSpace = objOutlook.GetNamespace("MAPI")
   Set objFolder = objnSpace.PickFolder ''' Dialog
  
With Sheets("Outlook") 'Tabellennamen anpassen !!!!!!!
  
   'Zellen leer machen für neue Daten
   .Range("A2:C" & .Rows.Count).Clear
  
   'Überschrift
   .Cells(1, 1) = "Absender"
   .Cells(1, 2) = "Datum"
   .Cells(1, 3) = "Betreff"
   .Range("A1:C1").Font.Bold = True
  
   'Array Dimensionieren
   Redim myAr(1 To objFolder.Items.Count, 1 To 3)
  
   'Mails aus Ordner lesen
   For Each objMsg In objFolder.Items
            LRow = LRow + 1
            myAr(LRow, 1) = objMsg.SenderEmailAddress 'Mail- Adresse
            myAr(LRow, 2) = objMsg.ReceivedTime 'Datum
            myAr(LRow, 3) = objMsg.Subject 'Betreff
   Next objMsg
   
   'Daten in Zellen schreiben
   .Range("A2").Resize(LRow, 3) = myAr
   'Breite der Spalten anpassen
   .Columns("A:C").EntireColumn.AutoFit
End With

End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

danke

nicht gefunden oder falsch gesucht
Danke

gruß
dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP