' Variante #1
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
  If TypeOf Item Is Outlook.MailItem Then
    SaveSentMail Item
  End If
End Sub

Private Sub SaveSentMail(Item As Outlook.MailItem)
  Dim Inbox As Outlook.MAPIFolder
  Dim Subfolder As Outlook.MAPIFolder

  If Item.DeleteAfterSubmit = False Then
    Set Inbox = Application.Session.GetDefaultFolder(olFolderInbox)
    Set Subfolder = Inbox.Folders("Ablage")
    Set Item.SaveSentMessageFolder = Subfolder
  End If
End Sub

' --------------------------------------------
' Variante #2
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
  If TypeOf Item Is Outlook.MailItem Then
    Cancel = Not SaveSentMail(Item)
  End If
End Sub

Private Function SaveSentMail(Item As Outlook.MailItem) As Boolean
  Dim F As Outlook.MAPIFolder

  If Item.DeleteAfterSubmit = False Then
    Set F = Application.Session.PickFolder
    If Not F Is Nothing Then
      Set Item.SaveSentMessageFolder = F
      SaveSentMail = True
    End If
  End If
End Function

' --------------------------------------------
' Variante #3
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
  If TypeOf Item Is Outlook.MailItem Then
    SaveSentMail Item
  End If
End Sub

Private Sub SaveSentMail(Item As Outlook.MailItem)
  Dim Inbox As Outlook.Folder
  Dim SubFolder As Outlook.Folder

  If Item.DeleteAfterSubmit = False Then
    Set Inbox = Application.Session.GetDefaultFolder(olFolderInbox)

    Select Case LCase$(Item.SendUsingAccount.DisplayName)
    Case "mvp"
      Set SubFolder = Inbox.Folders("ablage")
    Case "sample"
      Set SubFolder = Inbox.Folders("another sample folder")
    End Select

    If Not SubFolder Is Nothing Then
      Set Item.SaveSentMessageFolder = SubFolder
    End If
  End If
End Sub