Public Sub Initialize_handler()
    Set Application = Outlook.Application
End Sub
 
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim objRecip As Recipient
    Dim strMsg As String
    Dim res As Integer
    Dim strBcc As String
    On Error Resume Next
   ' Check if i use sending account on which i always want change reply to 
   ' address
    If InStr(Item.Subject, "Rechnung") > 0 Then
 
        ' Delete any existing reply recipients
        Do While Item.ReplyRecipients.Count > 0
          Item.ReplyRecipients.Remove 1
        Loop
        ' Add the new reply-to address
        strReplyToAddress = "buchaltung@meinefirma.ch"
        Set objRecip = Item.ReplyRecipients.add(strReplyToAddress)
        objRecip.Resolve
    End If
End Sub