ungefähr so. die Outlookobjekte müssen natürlich noch entsprechend erzeugt werden bevor du sie nutzen kannst.
With Worksheets("Tabelle1") 'Blattname mit daten anpassen
Do
i = i + 1
' .Cells(i, "A").Value 'projekt
' .Cells(i, "B").Value 'Krit
' Definieren Sie den Filter für den Suchordner
strFilter = "[Betreff] = '" & .Cells(i, "B").Value & "'"
' Erstellen Sie den Suchordner
On Error Resume Next
Set olSearchFolder = olFolder.Folders(.Cells(i, "A").Value)
On Error GoTo 0
If olSearchFolder Is Nothing Then
Set olSearchFolder = olFolder.Folders.Add(.Cells(i, "A").Value, olSearch)
olSearchFolder.Items.AddSearchFolder olSearchFolder, strFilter
End If
Loop While .Cells(i, "A") <> ""
End With
|