Hi again,

Am Tue, 21 Jun 2016 16:39:46 +0200 schrieb Claus Busch:

Sub OutlookMail()

better try:

Sub OutlookMail()
Dim appOL As Outlook.Application
Dim objNameSpace As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Dim objItem As Object
Dim n As Long

Set appOL = CreateObject("outlook.Application")
Set objNameSpace = appOL.GetNamespace("MAPI")
Set objFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
Set objItems = objFolder.Items

For Each objItem In objItems
With objItem
If .Class = olMail Then
If InStr(.Subject, "Hallo") 0 Then
n = n + 1
Cells(n, 1) = .SenderName
Cells(n, 2) = .ReceivedTime
Cells(n, 3) = .Subject
Cells(n, 4) = .Body
End If
End If
End With
Next
Columns("A:D").AutoFit
Rows("1:" & n).AutoFit
End Sub


Regards
Claus B.
--
Windows10
Office 2016