Excel vba Outlook Ordner auslesen

Sub Eing_Auslesen()
Const strAbsenderName As String = "Absendername"
' An den Absender/Provider Anpassen!!!
'Const strAbsenderName As String = "vorname.nachname@xyz.de"
' Ende "An den Absender Anpassen!!!"
Dim objOutlook As Outlook.Application
Dim objnSpace As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder
Dim objMsg As Object
Dim objItem As Outlook.MailItem
Dim intCounter As Integer, intCount As Integer, iRow As Integer
Dim ws As Worksheet
Dim sText As String
Application.ScreenUpdating = False
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
Set objFolder = objnSpace.GetDefaultFolder(olFolderInbox)
intCount = objFolder.Items.Count
If intCount > 0 Then
Set ws = ActiveSheet
iRow = 2
For intCounter = 2 To intCount
Set objMsg = objFolder.Items(intCounter)
If objMsg.Class = olMail Then
Set objItem = objMsg
If UCase(objItem.SenderName) = UCase(strAbsenderName) Then
iRow = iRow + 1
ws.Cells(iRow, 1).Value = objItem.Body
End If
End If
Next intCounter
Set ws = Nothing
End If
Set objnSpace = Nothing
Set objFolder = Nothing
Set objMsg = Nothing
Set objItem = Nothing
Set objOutlook = Nothing
' Ordnen
ActiveWorkbook.Worksheets("Arbeitsblatt1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Arbeitsblatt1").AutoFilter.Sort.SortFields.Add Key _
:=Range("M1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Arbeitsblatt1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub