Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Adding a Send and File Button

Outlook FAQs

Adding a Send and File Button

by  markdmac  Posted    (Edited  )
Managing email can be a challenge. I wanted to create a button that would simplify the process to send an email and direct the saved message to a particular folder instead of SentItems.

To be clear, the Outlook 2010 ribbon already has this feature, however it requires switching tabs, selecting the destination folder, changing tabs again and pressing Send. More often than not I find I forget to select the destination folder and have to move my sent messages manually.

The solution I created gives me a button that calls up a folder dialog so I can select the save to folder, when I click OK it also sends the message.

Setup is fairly easy. To begin, make sure you have created a self signed certificate using the Microsoft SelfCert utility. On my 64 bit system SelfCert.exe is located in the folder C:\Program Files\Microsoft Office\Office14. Just double click SelfCert.exe and type your name in the box to create a certificate.

Now that you have a certificate, let's setup the VBA code.

1. Open Microsoft Outlook
2. Press Alt+F11
3. On the left hand side, double click ThisOutlookSession
4. In the right hand pane, paste the following code

Code: 
Sub SendAndFile()
    On Error Resume Next
    'First find the current mail object
    Dim objMailItem As Object
    Set objMailItem = Application.ActiveInspector.CurrentItem
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
 
    If Item.Class = olMail Then ' used to act only on mail messages
      Set objNS = Application.GetNamespace("MAPI")
      'Now browse to the folder to send to
      Set objFolder = objNS.PickFolder
      If Not objFolder Is Nothing Then
        If IsInDefaultStore(objFolder) Then
            'Set the folder to save in to our choice
            Set objMailItem.SaveSentMessageFolder = objFolder
        End If
      Else
          Exit Sub
      End If
    End If
    'Send the email message
    objMailItem.Send
    
    Set objFolder = Nothing
End Sub

Public Function IsInDefaultStore(objOL As Object) As Boolean
  Dim objApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Dim objInbox As Outlook.MAPIFolder
  On Error Resume Next
  Set objApp = CreateObject("Outlook.Application")
  Set objNS = objApp.GetNamespace("MAPI")
  Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
  Select Case objOL.Class
    Case olFolder
      If objOL.StoreID = objInbox.StoreID Then
        IsInDefaultStore = True
      End If
    Case olAppointment, olContact, olDistributionList, _
         olJournal, olMail, olNote, olPost, olTask
      If objOL.Parent.StoreID = objInbox.StoreID Then
        IsInDefaultStore = True
      End If
    Case Else
      MsgBox "This function isn't designed to work " & _
             "with " & TypeName(objOL) & _
             " items and will return False.", _
             , "IsInDefaultStore"
  End Select
  Set objApp = Nothing
  Set objNS = Nothing
  Set objInbox = Nothing
End Function

5. Click Tools, Digital Signature
6. Click the Choose button and select your self signed certificate
7. Click the Save button
8. Close the VBA editor
9. Click the New Mail icon in the ribbon
10. Right click the blank space on the right side of the ribbon
11. Select "Customize the Ribbon"
12. Click New Group on the right side
13. Click Rename
14. Type Send and File then click OK
15. Select Macros from the dropdown on the left side
16. Select the Send and File macro on the left
17. Click Add>>
18. Select the macro on the right side and click Rename
19. Rename the text to "Send and File"
20. Select a different icon if desired
21. Click OK twice

You should now see a new icon on the new message screen's ribbon. Compose your email and use this new button instead

of the standard send button to allow you to send the email and be prompted for a folder to save the message in.

If you would like to add a button to the ribbon or quick launch to allow you to select multiple messages in your inbox or sent items and move them to a sub folder, the process is relatively the same as above. First right click on ThisOutlookSession and choose Insert> Module. Paste the following code into the new module window. Save the changes and add a button to your ribbon. You will now be able to select multiple items, press the button and specify what folder to move the items to. Note that you will likely need to close Outlook and re-open it for the new module to kick in.

Code: 
Sub MoveToProjectFolder()
On Error Resume Next

Dim ns As Outlook.NameSpace
Dim MoveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem

Set ns = Application.GetNamespace("MAPI")

'Now browse to the folder to send to
Set MoveToFolder = ns.PickFolder

If Application.ActiveExplorer.Selection.Count = 0 Then
    MsgBox ("No item selected")
    Exit Sub
End If

If MoveToFolder Is Nothing Then
    MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
End If

For Each objItem In Application.ActiveExplorer.Selection
    If MoveToFolder.DefaultItemType = olMailItem Then
        If objItem.Class = olMail Then
            objItem.Move MoveToFolder
        End If
    End If
Next

Set objItem = Nothing
Set MoveToFolder = Nothing
Set ns = Nothing

End Sub

Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top