Outlook Funktionspostfach auslesen

Public Sub ReadMailItems()
Dim olapp        As Object
Dim olName       As Object
Dim olHFolder    As Object
Dim olHFolder2   As Object
Dim olUFolder    As Object
Dim olUFolder2    As Object
Dim strAttCount  As String
Dim olItemsCount As Long
Dim lngAttCount  As Long
Dim letzteZeile  As Long
On Error Resume Next
Set olapp = CreateObject("Outlook.Application")
Set olName = olapp.GetNamespace("MAPI")
Set olHFolder = olName.Session.Folders("POSTFACHNAME")
Set olUFolder = olHFolder.Folders("Posteingang")
Set olUFolder2 = olHFolder2.Folders("NAME DES UNTERORDNERS")
[A1].Value = "E-Mail-Ordner"
[B1].Value = "Datum//Uhrzeit"
[C1].Value = "Empfänger"
Rows(1).Font.Bold = True
For olItemsCount = 1 To olUFolder.Items.Count
With olUFolder.Items.Item(olItemsCount)
For lngAttCount = 1 To .Attachments.Count
If strAttCount = "" Then
strAttCount = .Attachments.Item(lngAttCount).Filename
Else
strAttCount = strAttCount & vbCrLf & .Attachments.Item(lngAttCount).  _
_
Filename
End If
Next lngAttCount
Sheets("Tabelle2").Range("A" & olItemsCount + letzteZeile).Value = olHFolder.  _
_
Name & "->" & olUFolder.Name
Sheets("Tabelle2").Range("B" & olItemsCount + letzteZeile).Value = . _
ReceivedTime
Sheets("Tabelle2").Range("C" & olItemsCount + letzteZeile).Value = .To
strAttCount = ""
End With
Next olItemsCount
letzteZeile = Sheets("Tabelle2").Range("A" & Rows.Count).End(xlUp).Row
For olItemsCount = 1 To olUFolder2.Items.Count
With olUFolder2.Items.Item(olItemsCount)
For lngAttCount = 1 To .Attachments.Count
If strAttCount = "" Then
strAttCount = .Attachments.Item(lngAttCount).Filename
Else
strAttCount = strAttCount & vbCrLf & .Attachments.Item(lngAttCount).  _
_
Filename
End If
Next lngAttCount
Sheets("Tabelle2").Range("A" & olItemsCount + letzteZeile).Value = olHFolder2.  _
_
Name & "->" & olUFolder2.Name
Sheets("Tabelle2").Range("B" & olItemsCount + letzteZeile).Value = .SenderEmailAddress
Sheets("Tabelle2").Range("B" & olItemsCount + letzteZeile).Value = . _
ReceivedTime
Sheets("Tabelle2").Range("C" & olItemsCount + letzteZeile).Value = .To
End With
Next olItemsCount
On Error GoTo 0
End Sub