PDA

View Full Version : "Save As" Macro in Outlook 2010



SparkyMcFly
07-27-2011, 02:35 AM
We need somethnig very very simple but unfortunately I cannot see anything this simple on the forums (there are numerous complicated solutions to greater problems but all do a lot more than I need).

Quite simlpy I need to be able to save a selected message from within Outlook 2010 to a folder on the network.

The idea is to have an Icon on the Ribbon (top of the screen anyway!) which when you click it will simply save a copy of the single email to our V drive on the network.

Charlize
07-27-2011, 06:59 AM
You could try this coding. I assume you know how to add a macro to the quick toolbar and change the icon and description for your macro. No errorchecking for anything. You need to make sure the drive exists and that you have selected an email item.
Option Explicit
'define the constant for saving
Const mypath = "V:\"
Sub save_to_v()
'the mail we want to process
Dim objItem As Outlook.MailItem
'question for saving, use subject to save
Dim strPrompt As String, strname As String
'variables for the replacement of illegal characters
Dim sreplace As String, mychar As Variant, strdate As String
'put active mail in this object holder
Set objItem = Outlook.ActiveExplorer.Selection.Item(1)
'check if it's an email ... need to take a closer look cause
'gives an error when something else (contact, task) is selected
'because objItem is defined as a mailitem and code errors out
'saving does work, if you take care that a mailitem is selected
'before executing this code
If objItem.Class = olMail Then
'check on subject
If objItem.Subject <> vbNullString Then
strname = objItem.Subject
Else
strname = "No_Subject"
End If
strdate = objItem.ReceivedTime
'define the character that will replace illegal characters
sreplace = "_"
'create an array to loop through illegal characters (saves lines)
For Each mychar In Array("/", "\", ":", "?", Chr(34), "<", ">", "¦")
'do the replacement for each character that's illegal
strname = Replace(strname, mychar, sreplace)
strdate = Replace(strdate, mychar, sreplace)
Next mychar
'Prompt the user for confirmation
strPrompt = "Are you sure you want to save the item?"
If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
objItem.SaveAs mypath & strname & "--" & strdate & ".msg", olMSG
Else
MsgBox "You chose not to save."
End If
End If
End Sub

SparkyMcFly
07-27-2011, 02:11 PM
I will try this tomorrow with crossed fingers!