Outlook macro help

supert8ch

New Member
Joined
Feb 8, 2008
Messages
22
I am trying to use this macro to send emails to folders. But not able to get the proper format to come out correctly.
I wish to have the format show up as
MMDDYYYY HHMM Name Subject.msg
(name would be who sent email as showing in Outlook)

I end up getting:
MMDDYYYYY HHMM AMD Subject.msg

Here is the code I found that gets me almost to the right setup.
Sub SaveAsnewname()
'this macro saves selected emails to a chosen location with the format
' "DATE TIME INITIALS message subject", and includes the attachments in it as it is in .msg format Dim Mitem As Outlook.MailItem
Dim prompt As String
Dim name As String
Dim Nname As String
Dim Exp As Outlook.Explorer
Dim sln As Outlook.Selection

Set Exp = Application.ActiveExplorer
Set sln = Exp.Selection
If sln.Count = 0 Then
MsgBox "No objects selected."
Else
myPath = BrowseForFolder("\\")

Set Mitem = Outlook.ActiveExplorer.Selection.Item(1)


Nname = InputBox("Please enter subject or leave blank for email subject line(S) Please note THIS WILL GIVE ALL SELECTED EMAILS THE SAME TITLE, therefore they will only be distinguishable by date and time.")


For Each Mitem In sln


If Mitem.Class = olMail Then
If Nname = "" Then
name = Mitem.subject
Else
name = Nname
End If
' Cleanse illegal characters from subject... :/|*?<>" etc or sharepoint wont have it!
name = Replace(name, "<", "(")
name = Replace(name, ">", ")")
name = Replace(name, "&", "n")
name = Replace(name, "%", "pct")
name = Replace(name, """", "'")
name = Replace(name, "´", "'")
name = Replace(name, "`", "'")
name = Replace(name, "{", "(")
name = Replace(name, "[", "(")
name = Replace(name, "]", ")")
name = Replace(name, "}", ")")
name = Replace(name, " ", "_")
name = Replace(name, " ", "_")
name = Replace(name, " ", "_")
name = Replace(name, "..", "_")
name = Replace(name, ".", "_")
name = Replace(name, "__", "_")
name = Replace(name, ": ", "_")
name = Replace(name, ":", "_")
name = Replace(name, "/", "_")
name = Replace(name, "\", "_")
name = Replace(name, "*", "_")
name = Replace(name, "?", "_")
name = Replace(name, """", "_")
name = Replace(name, "__", "_")
name = Replace(name, "|", "_")


If myPath = False Then
MsgBox "No directory chosen !", vbExclamation
Else
Mitem.SaveAs myPath & "\" & Format(Mitem.ReceivedTime, "MMDDYYYY HHMM") & " AmB " & name & ".msg", olMSG
End If
Else
MsgBox "You have not saved"
End If

Next Mitem

End If
End Sub
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function To Browse for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level
Dim ShellApp As Object
'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.path
On Error GoTo 0
'Destroy the Shell Application
Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
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:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False
End Function
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

Forum statistics

Threads
1,225,635
Messages
6,186,128
Members
453,340
Latest member
Stu61

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top