Attribute VB_Name = "SendButtons_EN"
' 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 SendOnly()
    ' 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 "This function must be used from within an open e-mail.", vbExclamation
    Exit Function
End Function

Public Sub SendOnly_AddButton()
    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:="SendOnly")
    If Not sendOnlyButton Is Nothing Then
        MsgBox "The [Send Only] button already exists!", 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 = "Send only"
        .FaceId = 24
        .OnAction = "SendOnly"
        .Style = msoButtonIconAndCaption
        .Tag = "SendOnly"
        .TooltipText = "Send without saving to the Sent Items folder."
    End With
    insp.Close olDiscard
    
    MsgBox "[Send Only] button successfully installed.", vbInformation
End Sub

Public Sub SendOnly_RemoveButton()
    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:="SendOnly")
    If sendOnlyButton Is Nothing Then
        Exit Sub
    End If
    
    sendOnlyButton.Delete
    
    insp.Close olDiscard
    MsgBox "[Send Only] button successfully removed.", vbInformation
End Sub

Public Function SendAndFile()
    ' 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 "This function must be used from within an open e-mail.", vbExclamation
        Exit Function
    End If
End Function

Public Sub SendAndFile_AddButton()
    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:="SendAndFile")
    If Not sendAndFileButton Is Nothing Then
        MsgBox "The [Send and File...] button already exists!", 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 = "Send and File..."
        .FaceId = 24
        .OnAction = "SendAndFile"
        .Style = msoButtonIconAndCaption
        .Tag = "SendAndFile"
        .TooltipText = "Prompts for a folder to store the email before sending"
    End With
    
    insp.Close olDiscard
    
    MsgBox "[Send and File...] button successfully installed.", vbInformation
End Sub

Public Sub SendAndFile_RemoveButton()
    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:="SendAndFile")
    If sendOnlyButton Is Nothing Then
        Exit Sub
    End If
    
    sendOnlyButton.Delete
    
    insp.Close olDiscard
    MsgBox "[Send and File...] button successfully removed.", vbInformation
End Sub