Outlook E-Mail-Texte in Excel einfügen

[Tina82]

Hallo zusammen,

ich habe eine Outlook Mailbox in der jede Menge E-Mails mit Kundenanfragen sind. Ich würde gerne eine Auswertung darüber machen, was die Kunden fragen und dafür gerne alle Outlook E-Mails inklusive Nachrichtentext in Excel einfügen. Ein Kollege von mir, der leider nicht mehr da ist, hat dies schon mal gemacht, leider weiß ich aber nicht wie. Wenn ich es versuche schreibt es immer den Nachrichtentext in mehrere Zellen. Ich hätte aber gerne, dass er in 1 Zelle bleibt, um eine Tabelle zu bekommen.
Kann mir jemand helfen, wie ich das machen muss. Hab über die Suche und Google Suche leider nichts passendes gefunden.
Vielen Dank schon mal

[volti]

Hallo Tina,

da Du keine genaueren Angaben machst oder gar eine bereits angefangene Vorlage hier hochgeladen hast, hier mal aus meiner Bastelkiste ein mögliches Vorgehen zum Downloaden von eMails. Hierbei können die Mails auch auf die Absender eingeschränkt werden.

Probiere es einfach mal aus und/oder passe es Dir an:

Option Explicit

Sub GetAllMyMails()
'Sub liest die Mails des Posteingangs ein und listet die einzelnen Komponenten im Register Mails auf
 Dim i As Integer, j As Integer, n As Integer, sMails() As String, iAnz As Integer
 Dim sAbsender As String
 
 sAbsender = "Face*"               'Zur Zeit eingeschränkt auf Facebook
 
 With ThisWorkbook.Sheets("Mails")
  .Cells.ClearContents

'Überschrift im MailRegister schreiben
  .Cells(1, 1).Resize(1, 10) = _
  Split("Absender Betreff gesendet Anz.Anl Mail-Text Wichtig gelesen Kopie-Empfänger Blindkopie-Empfänger Anlagen")
  
'Mails aus dem Posteinagng holen und verarbeiten
  With CreateObject("Outlook.Application").GetNamespace("MAPI")
  
   With .Folders("Voltmann-Khan@t-online.de").Folders("Posteingang")
    iAnz = .Items.Count
    ReDim sMails(iAnz, 9)
    
    For i = 0 To iAnz - 1
    
     With .Items(i + 1)
      If .SenderName Like sAbsender Or sAbsender = "" Then
       sMails(n, 0) = .SenderName
       sMails(n, 1) = .Subject
       sMails(n, 2) = .SentOn
       sMails(n, 3) = .Attachments.Count
       sMails(n, 4) = .body
       sMails(n, 5) = IIf(.Importance = 0, "nein", "ja")
       sMails(n, 6) = IIf(.Unread = 0, "nein", "ja")
       sMails(n, 7) = .CC
       sMails(n, 8) = .Bcc
Rem    sMails(n,7) = .ReminderSet    'Erinnerung
    
'Anlagen ermitteln
       With .Attachments
        
        For j = 1 To .Count
           sMails(i, 9) = sMails(n, 9) & .Item(j).Filename & vbLf
'  .Item(1).SaveAsFile "c:\test.xls"
        Next j
      
       End With
       n = n + 1
      End If
     End With
    
    Next i
  
   End With
  
  End With
  .Cells(2, "A").Resize(n, 10) = sMails()
 
 End With
 
 MsgBox "Habe " & n & " Mails abgeholt!", vbInformation, "Mails importieren"
End Sub

viele Grüße aus Freigericht
Karl-Heinz

[Tina82]

Super, vielen Dank dafür. Ich werde es nächste Woche mit einer Kollegin ausprobieren.