PDA

View Full Version : Converting save as macro from 2007 to 2010



mbmbmbmbmbmb
05-23-2012, 01:35 AM
hiya, guess it's time to delurk..

thanks for the wonderful site, has been a lot of help to me in the past :)

yesterday IT upgraded my computer to windows 7 with Office 2010.

i've had this macro in 2007 which has been a Godsend in making me actually file emails properly.. but i can't seem to get it to work in 2010, tried various iterations of declaring and setting as different things to no avail.. any help greatly appreciated!



Sub SaveAsnewname()
' Simplified from JohnBF's code, and then complicated some more by meeeeee
'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, "YYMMDD 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)
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

JP2112
05-23-2012, 07:03 PM
Welcome to the forum. Please use
tags when posting code.

By looking at your code I can't immediately tell what's wrong. Have you tried stepping through the code to see where it errors?

mbmbmbmbmbmb
05-25-2012, 12:36 AM
thanks :) will try remember to.

in debug i get



compile error:
Invalid Use of Object


on the line

If Mitem = Nothing Then


which confuses me a bit because


myPath = BrowseForFolder("\\")


is before this in the code, but it hasn't brought up the window to choose where to save.


:think:

JP2112
05-26-2012, 10:42 AM
I don't see any line in the code you posted that says

If Mitem = Nothing Then

??