Save selected email message as .msg file (with user to choose folder location)

Status
Not open for further replies.

Izbi

New Member
Outlook version
Outlook 2007
Email Account
Hi
The macro below works perfectly to save emails to your hard drive with a date prefix.
However, it only saves to "\Documents".
Is there some code that I can insert so that I can choose the folder path.
Thanks.



Option Explicit
Public Sub SaveMessageAsMsg()
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
For Each objItem In ActiveExplorer.Selection
Set oMail = objItem

sName = oMail.Subject
ReplaceCharsForFileName sName, "_"
dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnnss", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"

sPath = enviro & "\Documents\"
Debug.Print sPath & sName
oMail.SaveAs sPath & sName, olMSG
Next
End Sub
Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub
 

Izbi

New Member
Outlook version
Outlook 2007
Email Account
Diane
I have tried the above link but no success.
I'm a noob in visual basic so do not know where to place the code, Ive tried what I can but it will not work.
Thanks.
 

Izbi

New Member
Outlook version
Outlook 2007
Email Account
Also I am not sure whether to apply
"How to use Windows filepaths in a macro" or
"BrowseForFolder Function"
or both?

 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
if you want the windows folder picker, you need to use the browseforfolder function.


Get the function then change your code from
sPath = enviro & "\Documents\"

sPath= BrowseForFolder(enviro & "\Documents\")

this will open the folder browser with the documents folder selected as the default. you can use another default path if you want.
 

Izbi

New Member
Outlook version
Outlook 2007
Email Account
Diane
I don't know if we are talking about the same thing.
I've used the amended code as shown below and what happens is that it still saves to "\Documents" and this time adds the string of the folder you choose.
What I need is to choose where to save the file. Some emails are saved in one folder while others are saved in a another folder.
Cheers.




Option Explicit
Public Sub SaveMessageAsMsg()
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String

enviro = CStr(Environ("USERPROFILE"))
For Each objItem In ActiveExplorer.Selection
Set oMail = objItem

sName = oMail.Subject
ReplaceCharsForFileName sName, "_"

dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyy mm dd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, " hhnn", _
vbUseSystemDayOfWeek, vbUseSystem) & " - " & sName & ".msg"

sPath = BrowseForFolder(enviro & "\Documents\Mobile_add\")
Debug.Print sPath & sName
oMail.saveas sPath & sName, olMSG
Next
End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub




Function BrowseForFolder(Optional OpenAt As Variant) As Variant
Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0

Set ShellApp = Nothing
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function

Invalid:
BrowseForFolder = False
End Function
 

Izbi

New Member
Outlook version
Outlook 2007
Email Account
Diane
The code below now works with some minor tweak. It will save the email to the selected folder.
Now I would like to have the macro remember the last folder location it saved to; so that if I save more than 1 email I do not have to browse through multiple folders each time.
Is this posible?
Thanks.


*

Option Explicit
Public Sub SaveMessageAsMsg()
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String

enviro = CStr(Environ("USERPROFILE"))
For Each objItem In ActiveExplorer.Selection
Set oMail = objItem

sName = oMail.Subject
ReplaceCharsForFileName sName, "_"

dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyy mm dd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, " hhnn", _
vbUseSystemDayOfWeek, vbUseSystem) & " - " & sName & ".msg"

sPath = BrowseForFolder(enviro & "\Documents\Mobile_add\")
Debug.Print sPath & "\" & sName
oMail.saveas sPath & "\" & sName, olMSG
Next
End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub




Function BrowseForFolder(Optional OpenAt As Variant) As Variant
Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0

Set ShellApp = Nothing
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function

Invalid:
BrowseForFolder = False
End Function
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
you have two options (probably more, but two i can think of offhand) - one is persistent, the other is remembers only as long as outlook is running.

dim a string variable outside of the macro (under option explicit) then change this line to use it
sPath = BrowseForFolder(previousPath)

At the end of the macro, I'd set previousPath = sPath

the other is to write the path to the registry before exiting the macro and read it into browse for folder. http://www.slipstick.com/developer/read-and-change-a-registry-key-using-vba/ shows how to read/write to the registry.
 

Izbi

New Member
Outlook version
Outlook 2007
Email Account
Diane, what do you mean by "dim a string variable".
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
It's the stuff at the top of the macro - you need to add one for the new string, previousPath in my example. To put it outside of the macro, it would be like this:

Option Explicit
dim previousPath as string


Public Sub SaveMessageAsMsg()
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
sorry about that - use
Dim previousPath As Variant

but it starts at that folder - you can't browse up.
 

Izbi

New Member
Outlook version
Outlook 2007
Email Account
OK thanks for the effort. Much appreciate it.
Do you think there is any other way?
 

Izbi

New Member
Outlook version
Outlook 2007
Email Account
Diane, anything on this?
Is it possible to use "msoFileDialogFolderPicker" to recall last folder selected?
 
Status
Not open for further replies.
Thread starter Similar threads Forum Replies Date
Diane Poremsky Save Selected Email Message as .msg File New Slipstick.com Articles 11
S Email won't send if save folder selected in advance Using Outlook 1
S MS Outlook 2007 Outlook Personal Folders Backup: 'Save Backup' Grayed out.__Message suggests no folders selected for backup. Using Outlook 1
D Prevent popup of "Do you want to save changes?" when closing after opening an appointment to view Outlook VBA and Custom Forms 0
A Unable to save recurring Meeting to Documents folder due to error Using Outlook 2
M Outlook 2013 Script Assistance - Save Opened Link with Subject Added Outlook VBA and Custom Forms 1
R Use an ItemAdd to Save Attachments on Arrival Outlook VBA and Custom Forms 0
W Outlook Calendar does not save view any longer! Using Outlook 3
S automate save the .xlxs file to share Network Using Outlook 1
S save email from excel Outlook VBA and Custom Forms 1
Y Open and Save Hyperlink Files in multiple emails Outlook VBA and Custom Forms 9
9 Outlook 2016 How to save an Outlook attachment to a specific folder then delete the email it came from? Using Outlook 1
O Save attachments using hotkey without changing attributes Outlook VBA and Custom Forms 1
geofferyh Cannot get Macro to SAVE more than one message attachment??? Outlook VBA and Custom Forms 5
N Open & Save VBAProject.Otm using VBA Code Outlook VBA and Custom Forms 1
R VBA | Chosing path to save file Outlook VBA and Custom Forms 1
W Save and rename outlook email attachments to include domain name & date received Outlook VBA and Custom Forms 4
V Change default default save location to Quick Access Using Outlook 1
W Save Outlook attachment in network folder and rename to current date and time Outlook VBA and Custom Forms 18
C Change default "Save Sent Item To" folder Outlook VBA and Custom Forms 9
C Outlook - cannot save subject line changes Using Outlook 2
J Save E-mail attachments in a specific folder Outlook VBA and Custom Forms 0
I Outlook 2016 64bit - on receipt convert emails into PDF and save Outlook VBA and Custom Forms 2
V VB script code to save a specific email attachment from a given email Outlook VBA and Custom Forms 14
C Auto save outlook attachments when email is received Outlook VBA and Custom Forms 1
N editing drafts - won't let me save Using Outlook 12
nathandavies Email Details to Excel & Save as .MSG on one macro - combination of 2 macros Outlook VBA and Custom Forms 3
C Need VBA code to automatically save message outside outlook and add date Outlook VBA and Custom Forms 1
D Save Sent Item to Using Outlook 0
Diane Poremsky Export (Save) Outlook Contact photos New Slipstick.com Articles 0
Diane Poremsky Save Messages and Attachments to a New Folder New Slipstick.com Articles 0
B Delete/replace old files and save new attachments Using Outlook 1
E Outlook 2016 and Numerous Prompts to Save Emails Using Outlook 3
Diane Poremsky Save Outlook Email as a PDF New Slipstick.com Articles 0
Diane Poremsky Edit and Save Outlook's Read-Only Attachments New Slipstick.com Articles 0
Diane Poremsky Save Attachments to the Hard Drive New Slipstick.com Articles 2
B VBA Help Email that will save as draft and send as attachment Outlook VBA and Custom Forms 3
C Save Subject of Received Email as a String Outlook VBA and Custom Forms 1
C Rule To Save attachments on receipt of email Outlook VBA and Custom Forms 2
O Cannot open or save calendar items Using Outlook 0
Diane Poremsky Choosing the Folder to Save a Sent Message In New Slipstick.com Articles 0
Frédéric Save E mail using different path. Outlook VBA and Custom Forms 24
M Question: Is there a rule that will save email in Windows Explorer Outlook VBA and Custom Forms 3
B Auto Save of Attachments from Multiple Emails and forward attachments to user group Outlook VBA and Custom Forms 1
S using script rule to save attachments on arrival Outlook 2010 Outlook VBA and Custom Forms 9
S Save in folder other than Sent when replying with Quick Steps Using Outlook 5
L Save message from outlook to desktop in 2013 outlook Outlook VBA and Custom Forms 1
Mark Foley Where are Outlook categories save for IMAP? Using Outlook 12
Diane Poremsky Save Sent Items in Shared Mailbox using an Exchange Server Cmdlet New Slipstick.com Articles 0
Diane Poremsky Save Messages and Attachments to a New Folder New Slipstick.com Articles 0
Similar threads


















































Top