Outlook nur eine Mail auslesen

Sub BetreffsAuslesen()

Dim olApp As Object

Dim olFolder As Object

Dim olMail As Object

Dim i As Integer

i = 0

Set olApp = CreateObject("Outlook.Application")

Set olFolder = olApp.ActiveExplorer.currentfolder

For Each olMail In olFolder.items

ActiveSheet.Range("A1").Offset(i, 0).Value = olMail.Subject

i = i + 1

Next

End Sub