Outlook macro help

Status
Not open for further replies.

supert8ch

Member
Outlook version
Email Account
Exchange Server
having issues at this part of the macro.

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

(removed code)

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
 
I get AMB:

03132013 1024 AmB TEST.msg

Because the code says so:
mItem.SaveAs myPath & "\" & Format(mItem.ReceivedTime, "MMDDYYYY HHMM") & " AmB " & name & ".msg", olMSG

My test message subject had an invalid filename character (/) and it failed with that - I have code that strips invalid characters if you need it. Save Messages as *.DOC File Type - Slipstick Systems - it's at a the bottom of the code
 
I tweaked to it to strip invalid characters - added this code - use mItem.Sender to get the sender's name.

Dim sName As String

sName = Format(mItem.ReceivedTime, "MMDDYYYY HHMM") & " " & mItem.Sender & " " & name
ReplaceCharsForFileName sName, "_"
mItem.SaveAs myPath & "\" & sName & ".msg", olMSG

and the ReplaceCharsForFileName macro from the link I posted.
 
I tweaked to it to strip invalid characters - added this code - use mItem.Sender to get the sender's name.

Dim sName As String

sName = Format(mItem.ReceivedTime, "MMDDYYYY HHMM") & " " & mItem.Sender & " " & name
ReplaceCharsForFileName sName, "_"
mItem.SaveAs myPath & "\" & sName & ".msg", olMSG

and the ReplaceCharsForFileName macro from the link I posted.

I had to strip some code as it would not let me post some where around 4000 characters. Here is the code I stripped, it belongs at the (removed code )

' 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, "|", "_")



Thank you for your input will try it out later this afternoon.
 
Ah - so that is what was cut out of the code.

The code below goes right after the last of the replace names - and the bolded part is what you need to replace or edit. I replaced it with "_" & mItem.Sender & "_" for this format:

03132013_1530_Ben_Smith_RE_Follow_up_from_call.msg
If myPath = False Then
MsgBox "No directory chosen !", vbExclamation
Else
mItem.SaveAs myPath & "\" & Format(mItem.ReceivedTime, "YYYY-MM-DD HHMM") & "AmB " & name & ".msg", olMSG
End If
Else
MsgBox "You have not saved"
End If
 
One more thing - you have these 3 removing blanks but 2 have 2 spaces, so spaces don't get removed from mitem.subject.
name = Replace(name, " ", "_")
name = Replace(name, " ", "_")
name = Replace(name, " ", "_")
 
Here is a full version of the macro with my edits. If you want to use replace letters in the entire file name, you need to replace the strings after you put the filename together.




View attachment dianes-version.txt
 
Not sure if its the version I am running but it does not like this line:

name = Format(mItem.ReceivedTime, "MMDDYYYY HHMM") & " " & mItem.Sender & " " & name

And states:

Run time error '438'

Object doesn't support this property or method.

maybe the mItem.Sender is suppose to be something else. Will try changing it to something else tonight when I get home. Thank you for the help on this. I am new to macros and VB so this helps me in the right direction.
 
Use sendername with Outlook 2003, not sender. I forgot to look at your version.

ETA: sendername will work on all versions.
 
Well that was the issue. It works great. Now I have to play with it and see if I can get it to work on email directories. I have couple hundred with thousands of emails to output to file.

Thank you for your time on this.
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
J Help Please!!! Outlook 2016 - VBA Macro for replying with attachment in meeting invite Outlook VBA and Custom Forms 9
C Newbie needs help with Outlook Macro Outlook VBA and Custom Forms 3
A newb outlook macro help Outlook VBA and Custom Forms 1
F Help with Outlook 2007 Macro Please! Using Outlook 4
S Outlook 2003: Help with setting up a macro to reply to selected emails Using Outlook 2
L Help for writing an Outlook 2007 macro Outlook VBA and Custom Forms 7
V Outlook macro help please Outlook VBA and Custom Forms 23
X Custom icon (not from Office 365) for a macro in Outlook Outlook VBA and Custom Forms 1
C Outlook - Macro to block senders domain - Macro Fix Outlook VBA and Custom Forms 1
J Outlook 365 Outlook Macro to Sort emails by column "Received" to view the latest email received Outlook VBA and Custom Forms 0
M Outlook Macro to save as Email with a file name format : Date_Timestamp_Sender initial_Email subject Outlook VBA and Custom Forms 0
D Outlook 2016 Creating an outlook Macro to select and approve Outlook VBA and Custom Forms 0
S Outlook Macro for [Date][Subject] Using Outlook 1
E Outlook - Macro - send list of Tasks which are not finished Outlook VBA and Custom Forms 3
S Macro for Loop through outlook unread emails Outlook VBA and Custom Forms 2
Witzker Macro to move @domain.xx of a Spammail to Blacklist in Outlook 2019 Outlook VBA and Custom Forms 7
S Macro for other actions - Outlook 2007 Outlook VBA and Custom Forms 23
S Macro to move “Re:” & “FWD:” email recieved the shared inbox to a subfolder in outlook Outlook VBA and Custom Forms 0
S Outlook Macro to send auto acknowledge mail only to new mails received to a specific shared inbox Outlook VBA and Custom Forms 0
S Outlook Macro to move reply mail based on the key word in the subjectline Outlook VBA and Custom Forms 0
M Outlook macro to automate search and forward process Outlook VBA and Custom Forms 6
R Macro Schedule every day in Outlook Using Outlook 0
L Moving emails with similar subject and find the timings between the emails using outlook VBA macro Outlook VBA and Custom Forms 1
N How can I increase/faster outlook VBA Macro Speed ? Using Outlook 2
A Outlook macro to create search folder with mail categories as criteria Outlook VBA and Custom Forms 3
V Outlook Macro to show Flagged messages Outlook VBA and Custom Forms 2
S Macro using .SendUsingAccount only works the first time, after starting Outlook Outlook VBA and Custom Forms 4
M Slow VBA macro in Outlook Outlook VBA and Custom Forms 5
A Forward Outlook Email by Filtering using Macro Rule Outlook VBA and Custom Forms 44
Tanja Östrand Outlook 2016 - Create Macro button to add text in Subject Outlook VBA and Custom Forms 1
D Outlook macro with today's date in subject and paste clipboard in body Outlook VBA and Custom Forms 1
C Outlook Subject Line Macro Outlook VBA and Custom Forms 0
D Macro sending outlook template from Excel list Outlook VBA and Custom Forms 6
P Macro to attach a file in a shared Outlook draft folder Outlook VBA and Custom Forms 2
R Macro to check file name with outlook address book Outlook VBA and Custom Forms 0
Diane Poremsky Use a macro to copy data in Outlook email to Excel workbook Using Outlook 0
W macro to export outlook emails to excel Outlook VBA and Custom Forms 6
J Outlook Macro to Update Sharepoint Excel File Using Outlook 1
Patrick van Berkel Best way to share (and keep up-to-date) Macro's in Outlook 2010 Outlook VBA and Custom Forms 6
L Outlook 2007 - Macro Re Search Using Outlook 16
L Outlook 2007 Macro to Contact From a Field Using Outlook 3
Diane Poremsky Macro to Bulk Import Contacts and vCards into Outlook Using Outlook 0
S Outlook 7 VBA macro for multiple filing Outlook VBA and Custom Forms 1
S Macro in an excel for outlook. Outlook VBA and Custom Forms 2
A Outlook Macro Causing Excel Error Outlook VBA and Custom Forms 0
Diane Poremsky Use a macro to copy data in Outlook email to Excel workbook Using Outlook 0
S Outlook Macro Reply to a message Outlook VBA and Custom Forms 1
Diane Poremsky Macro to Bulk Import vCards into Outlook Using Outlook 0
M Outlook VBA Macro that could retrieve/display the (From, Subject, Date Received) Outlook VBA and Custom Forms 2
Philip Rose Recreating a WORD Editing Macro to use in Outlook VBA Outlook VBA and Custom Forms 4

Similar threads

Back
Top