Outlook Makro zur Ablage gesendeter Mails im Posteingang

'als Standard werden alle Mail im Posteingang des Standard-Postfachs abgelegt - das klappt  
    Set Item.SaveSentMessageFolder = Outlook.Session.GetDefaultFolder(olFolderInbox)
'wenn "senden von" genutzt wird, den Posteingang des entsprechenden Kontos wählen:  
    If Item.SentOnBehalfOfName <> "" Then Set Item.SaveSentMessageFolder = GetFolder(Item.SentOnBehalfOfName & "\posteingang")  

Public Function GetFolder(strFolderPath As String) As MAPIFolder
  ' strFolderPath needs to be something like  
  '   "Public Folders\All Public Folders\Company\Sales" or  
  '   "Personal Folders\Inbox\My Folder"  

  Dim objApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Dim colFolders As Outlook.Folders
  Dim objFolder As Outlook.MAPIFolder
  Dim arrFolders() As String
  Dim i As Long
 ' On Error Resume Next  

  strFolderPath = Replace(strFolderPath, "/", "\")  
  arrFolders() = Split(strFolderPath, "\")  
  Set objApp = Application
  Set objNS = objApp.GetNamespace("MAPI")  
  Set objFolder = objNS.Folders.Item(arrFolders(0))
  If Not objFolder Is Nothing Then
    For i = 1 To UBound(arrFolders)
      Set colFolders = objFolder.Folders
      Set objFolder = Nothing
      Set objFolder = colFolders.Item(arrFolders(i))
      If objFolder Is Nothing Then
        Exit For
      End If
    Next
  End If

  Set GetFolder = objFolder
  Set colFolders = Nothing
  Set objNS = Nothing
  Set objApp = Nothing
End Function

If Mid(Item.Subject, 1, 4) = "test" Then  
    Item.HTMLBody = "Ordner: " & Item.SaveSentMessageFolder.FolderPath & _  
    "<br> SentOnBehalfOfName: " & Item.SentOnBehalfOfName  
End If