Outlook Funktionspostfach auslesen

Hallo liebe Community,
ich benötige eure Unterstützung!
Ich möchte mit Excel VBA ein Outlook Funktionspostfach (ungelesene E-Mails auslesen).
Problem: Bisher werden die E-Mails aus dem Ordner "Posteingang", jedoch nicht aus allen Unterordner (12 Stück) ausgelesen. Ich habe erstmal versucht einen weiteren Unterordner auszulesen, allerdings scheitere ich hier. Des Weiteren werden alle E-Mails und nicht nur die ungelesenen aufgelistet.
Der bisherige Code:
Option Explicit


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

Könnt Ihr mir bitte weiterhelfen? Für eure Unterstützung bedanke ich mich bereits im Voraus!
Vielen Dank und liebe Grüße
Marko

Richtig, ungünstige Voraussetzungen :-) Ich lerne gerade und habe Spaß dabei. Nachwuchs tut ja immer gut :-)
Ich bin sehr froh, dass man sich in diesem Forum austauschen kann und Hilfe bekommt! So macht lernen auch Spaß!
Der Code ist:

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 olOrdner As Outlook.MAPIFolder
Dim strAttCount As String
Dim strAttCount2 As String
Dim olItemsCount As Long
Dim olItemsCount2 As Long
Dim lngAttCount As Long
Dim lngAttCount2 As Long
Dim letzteZeile As Long
Dim AnzahlEmail As Integer, i As Integer, Email As Integer, a 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 = olHFolder.Folders("Unterordner")
Set olOrdner = GetObject("", "Outlook.Application").Session.Stores("Postfachname"). _
GetDefaultFolder(6).Folders("Posteingang").Folders("Unterordner").Folders
AnzahlEmail = olOrdner.Items.Count
[A1].Value = "E-Mail-Ordner"
[B1].Value = "Datum//Uhrzeit"
[C1].Value = "Empf䮧er"
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 = olUFolder.Name
Sheets("Tabelle2").Range("B" & olItemsCount + letzteZeile).Value = .ReceivedTime
Sheets("Tabelle2").Range("C" & olItemsCount + letzteZeile).Value = .To
strAttCount = ""
End With
Next olItemsCount2
letzteZeile = Sheets("Tabelle2").Range("A" & Rows.Count).End(xlUp).Row
For olItemsCount2 = 1 To olUFolder2.Items.Count
With olUFolder2.Items.Item(olItemsCount)
For lngAttCount2 = 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("Outlook-Auslese").Range("C" & olItemsCount + letzteZeile).Value = .To
End With
Next olItemsCount
On Error GoTo 0
Set olOrdner = Nothing
'Die Zelle 'A2' soll selektiert werden
[A2].Select
'Die Statuszeile wird wieder ausgeschaltet
Application.StatusBar = False
End Sub

Sub RecurseFolders(ByVal fldr As Object)
For Each itm In fldr.Items
Set n = Cells(Rows.Count, "A").End(xlUp).Offset(1)
With itm
n.Resize(1, 3).Value = Array(.Subject, .ReceivedTime, fldr.FolderPath)
End With
Next
'Prozedur ruft sich selbst fr alle Unterordner erneut auf
For Each subfolder In fldr.Folders
RecurseFolders subfolder
Next
End Sub
Das Problem ist, dass dieses Postfach 11 Unterordner hat. Ich habe es erstmal mit einem Unterordner probiert und dieser wird nicht erkannt. Lediglich der Posteingang wird erfasst.
Für die tolle Unterstützung bedanke ich mich bereits im Voraus!!!!

Outlook Funktionspostfach auslesen

Forumthread: Outlook Funktionspostfach auslesen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial