Attribute VB_Name = "SendButtons_DE"
' Description: This module provides some buttons for toolbar of Outlook's E-Mail composition form. The module has been tested with Outlook 2003.
' Version: 1.0
' Author: Sebastian Thomschke (http://sebthom.de)
Option Explicit

Public Function NurSenden()
    ' Sends the currently selected email without saving it
    If TypeName(Application.ActiveWindow) = "Inspector" Then
        Dim Item As Object
        Set Item = Application.ActiveInspector.CurrentItem
        If TypeName(Item) = "MailItem" Then
            Dim mail As Outlook.MailItem
            Set mail = Item
            mail.DeleteAfterSubmit = True
            mail.Send
            Exit Function
        End If
    End If
        
    MsgBox "Diese Funktion kann nur in einer geöffneten E-Mail verwendet werden.", vbExclamation
    Exit Function
End Function

Public Sub NurSenden_Installieren()
    Dim insp As inspector
    Set insp = Application.CreateItem(olMailItem).GetInspector
    On Error Resume Next
    
    Dim toolbar As commandBar
    Set toolbar = insp.CommandBars("Standard")
    
    Dim sendOnlyButton As CommandBarButton
    Set sendOnlyButton = toolbar.FindControl(Tag:="NurSenden")
    If Not sendOnlyButton Is Nothing Then
        MsgBox "Die Schaltfläche [Nur senden] ist bereits installiert!", vbExclamation
        Exit Sub
    End If

    Dim sendButton As CommandBarButton
    Set sendButton = toolbar.FindControl(ID:=2617)
    
    Set sendOnlyButton = toolbar.Controls.Add(msoControlButton, before:=sendButton.Index + 1)
    With sendOnlyButton
        .Caption = "Nur senden"
        .FaceId = 24
        .OnAction = "NurSenden"
        .Style = msoButtonIconAndCaption
        .Tag = "NurSenden"
        .TooltipText = "Versendet eine E-Mail, ohne diese unter [Gesendete Objekte] abzulegen."
    End With
    insp.Close olDiscard
    
    MsgBox "Die Schaltfläche [Nur senden] wurde erfolgreich installiert.", vbInformation
End Sub

Public Sub NurSenden_Entfernen()
    Dim insp As inspector
    Set insp = Application.CreateItem(olMailItem).GetInspector
    On Error Resume Next
    
    Dim toolbar As commandBar
    Set toolbar = insp.CommandBars("Standard")
    
    Dim sendOnlyButton As CommandBarButton
    Set sendOnlyButton = toolbar.FindControl(Tag:="NurSenden")
    If sendOnlyButton Is Nothing Then
        Exit Sub
    End If
    
    sendOnlyButton.Delete
    
    insp.Close olDiscard
    MsgBox "Die Schaltfläche [Nur senden] wurde erfolgreich entfernt.", vbInformation
End Sub

Public Function SendenUndAblegen()
    ' Prompts for a folder to store the email before sending
    If TypeName(Application.ActiveWindow) = "Inspector" Then
        Dim Item As Object
        Set Item = Application.ActiveInspector.CurrentItem
        If TypeName(Item) = "MailItem" Then
            Dim mail As Outlook.MailItem
            Set mail = Item

            Dim folder As MAPIFolder
            Set folder = Application.GetNamespace("MAPI").PickFolder
            If Not folder Is Nothing Then
                Set Item.SaveSentMessageFolder = folder
                mail.Send
            End If
        End If
    Else
        MsgBox "Diese Funktion kann nur in einer geöffneten E-Mail verwendet werden.", vbExclamation
        Exit Function
    End If
End Function

Public Sub SendenUndAblegen_Installieren()
    Dim insp As inspector
    Set insp = Application.CreateItem(olMailItem).GetInspector
    On Error Resume Next
    
    Dim toolbar As commandBar
    Set toolbar = insp.CommandBars("Standard")
    
    Dim sendAndFileButton As CommandBarButton
    Set sendAndFileButton = toolbar.FindControl(Tag:="SendenUndAblegen")
    If Not sendAndFileButton Is Nothing Then
        MsgBox "Die Schaltfläche [Senden und ablegen...] ist bereits installiert!", vbExclamation
        Exit Sub
    End If
    
    Dim sendButton As CommandBarButton
    Set sendButton = toolbar.FindControl(ID:=2617)
    
    Set sendAndFileButton = toolbar.Controls.Add(msoControlButton, before:=sendButton.Index + 1)
    With sendAndFileButton
        .Caption = "Senden und ablegen..."
        .FaceId = 24
        .OnAction = "SendenUndAblegen"
        .Style = msoButtonIconAndCaption
        .Tag = "SendenUndAblegen"
        .TooltipText = "Fragt vor dem Senden nach einem Order, in welchem die E-Mail abgelegt werden soll."
    End With
    
    insp.Close olDiscard
    
    MsgBox "Die Schaltfläche [Senden und ablegen...] wurde erfolgreich installiert.", vbInformation
End Sub

Public Sub SendenUndAblegen_Entfernen()
    Dim insp As inspector
    Set insp = Application.CreateItem(olMailItem).GetInspector
    On Error Resume Next
    
    Dim toolbar As commandBar
    Set toolbar = insp.CommandBars("Standard")
    
    Dim sendOnlyButton As CommandBarButton
    Set sendOnlyButton = toolbar.FindControl(Tag:="SendenUndAblegen")
    If sendOnlyButton Is Nothing Then
        Exit Sub
    End If
    
    sendOnlyButton.Delete
    
    insp.Close olDiscard
    MsgBox "Die Schaltfläche [Senden und ablegen...] wurde erfolgreich entfernt.", vbInformation
End Sub