AW: Text aus E-Mail kopieren?
16.10.2018 20:51:26
Dieter
Hallo Axel,
du kannst das z.B. mit dem folgenden Programm machen.
Es wird hier jeweils der gesamte Text der Eingangsmails übernommen. Du musst dir dann noch den Teil herausschneiden, der dich interessiert.
Sub Posteingang_lesen()
Dim letzteZeile As Long
Dim olWarNichtAktiv As Boolean
Dim olApp As Outlook.Application
Dim olEin As Outlook.MAPIFolder
Dim olNS As Outlook.Namespace
Dim olMail As Outlook.MailItem
Dim rng As Range
Dim ws As Worksheet
Dim zeile As Long
Set ws = ThisWorkbook.Worksheets(1)
letzteZeile = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
If letzteZeile = 1 Then letzteZeile = 2
ws.Range(ws.Range("A2"), ws.Cells(letzteZeile, "D")).ClearContents
On Error Resume Next
Set olApp = GetObject(Class:="Outlook.Application")
If Err 0 Then
Set olApp = CreateObject("Outlook.Application")
olWarNichtAktiv = True
End If
On Error GoTo 0
Set olNS = olApp.GetNamespace("MAPI")
Set olEin = olNS.GetDefaultFolder(Foldertype:=olFolderInbox)
zeile = 2
For Each olMail In olEin.Items
ws.Cells(zeile, "A") = olMail.SenderEmailAddress
ws.Cells(zeile, "B") = olMail.ReceivedTime
ws.Cells(zeile, "C") = olMail.Subject
ws.Cells(zeile, "D") = olMail.Body
ws.Cells(zeile, "D").WrapText = False
zeile = zeile + 1
Next olMail
If olWarNichtAktiv Then
olApp.Quit
End If
Set olApp = Nothing
MsgBox "Verarbeitung beendet" & vbNewLine & _
"Anzahl der Mails: " & zeile - 2
End Sub
Viele Grüße
Dieter