Outlook Macro... quick way to save the mails
I am currently using Outlook 2003 to check my emails. I have a case wherein I need to send the mail as an attachment to other user. The steps I used to do are :
- Open the mail
- Click File > SaveAs and save the mail as outlook message format
- Compose a new email and add this mail as attachment ( *.msg)
Since I was doing this quite often, I thought of writing a macro to quickly help me to do this. I completed it and thought of sharing with you. The code snippet given below
''''Saves the current mail in msg format for easy sending
''''Created by Senthil - Aug 16 2010
Public Sub SaveThisMail()
Dim pathString As String
Dim fullPath As String
Dim itemMessage As String
Dim fName As String ''' Only the file name
Dim selObject As Object
pathString = "C:\Documents and Settings\xxxxx\My Documents" --- Change the path here as per your need
Set selObject = Me.ActiveExplorer.Selection.Item(1)
If (TypeOf selObject Is Outlook.mailItem) Then
Dim mailItem As Outlook.mailItem
Set mailItem = selObject
End If
fName = Format(Now(), "ddMMYYYYHHmmss") & ".msg"
fullPath = pathString & "\" & fName
'''Save the mail
mailItem.SaveAs fullPath, OlSaveAsType.olMSG
'''To open the place where the file is located
Dim a As String
a = MsgBox("Saved successfully (File name: " & fName & " ). Want to see the location?", vbYesNo + vbDefaultButton1, "Save successful")
If a = vbYes Then
retVal = Shell("explorer.exe " & pathString, vbNormalFocus)
End If
End Sub
''''Created by Senthil - Aug 16 2010
Public Sub SaveThisMail()
Dim pathString As String
Dim fullPath As String
Dim itemMessage As String
Dim fName As String ''' Only the file name
Dim selObject As Object
pathString = "C:\Documents and Settings\xxxxx\My Documents" --- Change the path here as per your need
Set selObject = Me.ActiveExplorer.Selection.Item(1)
If (TypeOf selObject Is Outlook.mailItem) Then
Dim mailItem As Outlook.mailItem
Set mailItem = selObject
End If
fName = Format(Now(), "ddMMYYYYHHmmss") & ".msg"
fullPath = pathString & "\" & fName
'''Save the mail
mailItem.SaveAs fullPath, OlSaveAsType.olMSG
'''To open the place where the file is located
Dim a As String
a = MsgBox("Saved successfully (File name: " & fName & " ). Want to see the location?", vbYesNo + vbDefaultButton1, "Save successful")
If a = vbYes Then
retVal = Shell("explorer.exe " & pathString, vbNormalFocus)
End If
End Sub
What you need to do?
Open Outlook and select Tools>Macro> Visual Basic Editor
Paste the code written above in the "This Outlook Session" ( Please remember to edit the red line in the code as per your need)
Save the project and close it.
Now we will add a small button to the standard mail window. Open any mail and right click at the tool bar ( any icon). You will get a menu as shown below
Click Customize. Now go to Commands tab and go to Macros and select the macro SaveThisMail()
Simply drag the Command to the tool bar. Now you have the button ready at the tool bar. See below the screen.
Now you are good to go. Whenever you want to save this mail as .msg, simply click this button and the mail will be saved in your prescribed folder. You will be prompted to open the location and you can quickly select the file from the location.
(Note: Since this is a macro, whenever you open the Outlook, you will be prompted to Enable or Disable the macro. Enable the macro to have the above function working. Click the images if you want to see bigger)
