Outlook 2007 Macro to Save msg file to folder

\\My Network Location\000\Emails is the destination folder, where 000 would be a variable that I enter after launching my macro.

I would love if, when I select the message in my inbox message list (or if necessary or easier, while the message is open), I can run the macro from a toolbar button. A msgbox will ask me for the folder number, I'll enter the folder number and hit Enter, and it will save that msg file into the folder called Emails under that number. The numbers are, in actuality, up to 5 digits. It would probably take years to get to 6 digits, just in case that matters.

At that point, it would be nice if we got a 2-second msgbox that says "Message saved in the efile." and the msgbox closes and then end sub.

Any other information I can provide, I'm happy to provide.

I don't know Outlook programming at all, so a complete sub would be fantastic, with instructions where to save.
LVL 22
Anne TroyEast Coast ManagerAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

KimputerCommented:
Here's the code, works only if you open the email.
You can add the macro to the Quick access ribbon, also when the email is opened.
I could actually program to automatically name the file (means you don't have to check the folder yourself before you give it a name, just increase the name by one), but I think that's for another time.
Adjust pathname yourself.
Msgbox not included, as it behaves quite unpredictable, mostly NOT closing.
Maybe it will be possible with a new form, but that includes some more work, and more instructions for you to implement (forms)

It could also be that I did not totally understand your logic in input and saved name. As you say the number you input is for the folder, what about the filename (you mentioned one input)? So for now, it's one fixed folder, with the numbers you input turning into the filename. Having more files in one folder makes more sense than having LOADS of folders with just one email.


Sub SaveAsMSG()
    Dim myItem As Outlook.Inspector
    Dim objItem As Object
    PathName = "\\My Network Location\000\Emails\"
    Set myOlApp = CreateObject("Outlook.Application")
    Set myItem = myOlApp.ActiveInspector
    If Not TypeName(myItem) = "Nothing" Then
        Set objItem = myItem.CurrentItem
        StrName = InputBox("Save as...")
                        
        objItem.SaveAs PathName & StrName & ".msg", olMSG

    Else
            MsgBox "There is no current opened email item."
    End If
End Sub
    

Open in new window

0
Anne TroyEast Coast ManagerAuthor Commented:
OMG. Can't wait to get to work to try it! I don't need them numbered incrementally...they actually already have numbered folders.

Will let you know ASAP.
0
KimputerCommented:
So, the number you type in is for the folder number. But what about the filename (that's why I used now, what you enter will be the filename in the current code) ?
0
Newly released Acronis True Image 2019

In announcing the release of the 15th Anniversary Edition of Acronis True Image 2019, the company revealed that its artificial intelligence-based anti-ransomware technology – stopped more than 200,000 ransomware attacks on 150,000 customers last year.

Anne TroyEast Coast ManagerAuthor Commented:
The file name can remain the name of the msg. What I want to enter is the folder number. That's it.

Thanks so much for your help so far!
0
KimputerCommented:
if you say, remain the name of the message, I assume the subject ? In that case, are you sure you will not have the same subjects coming by a lot?
Will update code after your reply.
0
Anne TroyEast Coast ManagerAuthor Commented:
The subjects are generally different every time.  I'm not worried about it. It will simply ask if I want to overwrite, no?
0
Anne TroyEast Coast ManagerAuthor Commented:
If it is helpful for you to know, each folder is a different client. They are processed and moved on, so it's not ongoing. Only lasts a couple months, maybe, and each step along the way is different.
0
KimputerCommented:
This should be it, again adjust PathName = "\\My Network Location\", keep the slashes, as I'm not sure if this is really the existing folder.
If you type in wrong code (999, while folders are only up to 900), prompt will loop until valid folder has been input. After that, it will loop again if the file exists (based on subject), change filename to non-existent name before you can continue. If file doesn't exist, no further prompts are given.


Private Function File_Exists(ByVal sPathName As String, Optional Directory As Boolean) As Boolean

 'Returns True if the passed sPathName exist
 'Otherwise returns False
 On Error Resume Next
 If sPathName <> "" Then

 If IsMissing(Directory) Or Directory = False Then

 File_Exists = (Dir$(sPathName) <> "")
 Else

 File_Exists = (Dir$(sPathName, vbDirectory) <> "")
 End If

 End If
End Function
'Read more at http://vbadud.blogspot.com/2007/04/vba-function-to-check-file-existence.html#9188C8drGcULrtL4.99

Sub SaveAsMSG()
    Dim myItem As Outlook.Inspector
    Dim objItem As Object
    PathName = "\\My Network Location\"
    Set myOlApp = CreateObject("Outlook.Application")
    Set myItem = myOlApp.ActiveInspector
    If Not TypeName(myItem) = "Nothing" Then
        Set objItem = myItem.CurrentItem
        StrSub = objItem.Subject
        StrName = InputBox("Folder number...")
        Do While File_Exists(PathName & StrName & "\Emails\", True) = False
            StrName = InputBox("Folder does not exist, give a new number...", "new folder number")
        Loop
        Do While File_Exists(PathName & StrName & "\Emails\" & StrSub & ".msg") = True
            StrSub = InputBox("File exists, give a new file name...", "new file name", StrSub)
        Loop
        objItem.SaveAs PathName & StrName & "\Emails\" & StrSub & ".msg", olMSG
    Else
            MsgBox "There is no current opened email item."
    End If
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Anne TroyEast Coast ManagerAuthor Commented:
Ooops. That got me in a loop for a correct folder name...hitting Cancel doesn't work. I can find how to do the cancel button, though. I'll be back!
0
Anne TroyEast Coast ManagerAuthor Commented:
:( Can't figure that out. I don't know enough to figure out the name (variable?) you're using for the value that I input.
0
KimputerCommented:
You will have to close Outlook in the Task Manager if you are in a loop.
Just make sure the path exists, and you will always be able to get out.
So, the most important part is
PathName = "\\My Network Location\"
If that doesn't exist, you will always get in this loop.
If changed it to something that DOES exist like "c:\test\", you can break the loop by adding the folder "c:\test\000\Emails" in Explorer, and back in Outlook filling in 000
0
Anne TroyEast Coast ManagerAuthor Commented:
I can't ask 50 people to figure out how to get out of the loop or to remember the 000. I will have to keep looking. I did not get it to work at all. The path definitely exists.
0
Anne TroyEast Coast ManagerAuthor Commented:
I assume this code works, just needs to be tweaked. Thanks for your help.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.