×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Microsoft: Office FAQ

Outlook FAQs

Adding a Send and File Button by markdmac
Posted: 17 May 12 (Edited 18 May 12)

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

 

Back to Microsoft: Office FAQ Index
Back to Microsoft: Office Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close