Outlook 2007 redirect Save Sent Items folder by account

In Outlook 2007 can I redirect "save sent items" folder by account. So if I am sending an email through POP3 account 'A' the sent message copy is saved to a specific folder vs the default 'Sent' folder
LVL 14
BigBadWolf_000Asked:
Who is Participating?
 
Chris BottomleyConnect With a Mentor Commented:
I've sat and tested and pasted/restructured but didn't quite figure the actual error.  I think there were a couple of overlapping error confusing me!

The code below works for sure so replace both the checkpop and the olNav2Folder functions from the snippet

Chris
Sub checkPop(mai As mailitem)
Dim fldr As Object
Dim olkApp As Application
Dim cpy As String
Dim saveFolder As String
'Your_MailAccount_Name  is the account being analysed
 
    If LCase(mai.SendUsingAccount) = LCase(Your_MailAccount_Name) Then
        cpy = mai.Recipients.Item(1).Address & ";"
        cpy = Left(cpy, InStr(cpy, ";") - 1)
        cpy = Mid(cpy, InStr(cpy, "@") + 1)
        cpy = Left(cpy, InStr(cpy, ".") - 1)
        '\Personal Folders\Company\xxx\sent
        saveFolder = "\\Personal Folders\Company\" & cpy & "\sent"
        Set fldr = olNav2Folder(saveFolder, True)
        Set mai.SaveSentMessageFolder = fldr
    End If
 
End Sub
 
Public Function olNav2Folder(foldername As String, Optional createFolders As Boolean) As Object
Dim olApp As Object
Dim olNs As Object
Dim olfldr As Object
Dim reqdFolder As Object
Dim arrFolders() As String
Dim nestCount As Integer
 
    On Error Resume Next
    foldername = Replace(Replace(foldername, "/", "\"), "\\", "")
    If Right(foldername, 1) = "\" Then foldername = Left(foldername, Len(foldername) - 1)
    arrFolders() = Split(foldername, "\")
    Set olApp = CreateObject("Outlook.Application")
    Set olNs = olApp.GetNamespace("MAPI")
    Set reqdFolder = olNs.folders.Item(arrFolders(0))
    For nestCount = 1 To UBound(arrFolders)
        If Not reqdFolder Is Nothing Then
            Set olfldr = reqdFolder.folders
            Set reqdFolder = olfldr.Item(arrFolders(nestCount))
            If reqdFolder <> olfldr.Item(arrFolders(nestCount)) Then
                If createFolders Then
                    reqdFolder.folders.Add (arrFolders(nestCount))
                    Set olfldr = reqdFolder.folders
                    Set reqdFolder = olfldr.Item(arrFolders(nestCount))
                Else
                    Set reqdFolder = Nothing
                    Exit For
                End If
            End If
        Else
        End If
    Next
    Set olNav2Folder = reqdFolder
    Set olApp = Nothing
    Set olNs = Nothing
    Set olfldr = Nothing
    Set reqdFolder = Nothing
End Function

Open in new window

0
 
DiagnosticsCommented:
Do you not want it to go to your Sent message at all or is it okay if a copy also goes there? Under Tools there is a Rules and Alerts option which can create a rule that can send a copy of your sent item to a folder you specify.
0
 
BigBadWolf_000Author Commented:
Yeah I am aware of the copy rule workaround and the change folder for account . But, I want to stay in one PST and move the sent items with no copies.

Am open to using any plugins or code
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
DiagnosticsCommented:
If I may ask, why is it that you don't want a copy in your Sent Items folder? This can help me assess your intentions and aide in possibly coming up with a solution.
0
 
BigBadWolf_000Author Commented:
So I keep my PST as clean and manageable with less bloat as possible and no manual interaction :D
Also the copy rule sets copy as Unread in specified folder
0
 
BigBadWolf_000Author Commented:
Am also aware of the "...save replies with original message" option, but this too does it for all folders
0
 
DiagnosticsCommented:
Ouch, now I'm fresh out of ideas. Sorry.
0
 
BigBadWolf_000Author Commented:
It will not happen with Outlook native....need a plugin or code
0
 
BigBadWolf_000Author Commented:
Found this.....will test to see if it works :D
http://www.sperrysoftware.com/Outlook/Sent-Items-Organizer.asp
 
0
 
Chris BottomleyCommented:
It ought to be possible using a rule and a script to detect the sending account ... will that help?

Chris
0
 
BigBadWolf_000Author Commented:
Yes I am open to using a script with a rule as long as it moves and not just copies...even better would be if script would move sent message to specific folder by recipient email domain or full email address
0
 
BigBadWolf_000Author Commented:
or moves the copy and deletes the original
0
 
Chris BottomleyCommented:
Which accounts are to be addressed in this way and which folders for the related email to be saved to?

i.e. fred@fred.com ---> fred subfolder of sent items ... or whatever?

Chris
0
 
BigBadWolf_000Author Commented:
fred@fred.com Company (folder under root) > Fred (sub-folder under Company) > Sent (sub-folder under Fred)
preffered would be address w/o prefix just @fred.com
0
 
Chris BottomleyCommented:
OK, one last question I think in order to proceed ... you haven't identified a specific email or range of emails affected.

You originally  said POP account A, I interpret from the last post you want to do it for every email.  If it is only for pop accounts a-z then can you identify how I know which pop accounts are to processed in this way?

Chris
0
 
BigBadWolf_000Author Commented:
range of emails....all sent through a POP Account A
There a currently different email domains (3 for now but more in future)  that I send/reply email to strictly through this AccountA...(Outlook 2007 picks it auto for replies/forwards and I pick manually for sends)

So for every email I send/reply through AccountA...
if to @xxx.com then put sent msg in folder Company\xcorp\sent
if to @yyy.com then put sent msg in folder Company\ycorp\sent
if to @zzz.com then put sent msg in folder Company\zcorp\sent

0
 
Chris BottomleyCommented:
DO you have multiple POP accounts ... it's easier if I can ignore that aspect

Chris
0
 
BigBadWolf_000Author Commented:
Yes I have multiple pop accounts, but I want sent items managed only for AccountA
0
 
Chris BottomleyCommented:
To identify the correct definition can you run this macro which will return all of the POP3 accounts and copy the full text, (from the VBE immediate window) for the one in question here.

Chris
Sub itemisePOP3Accounts()
Dim olkApp As Application
Dim acct As Account
 
    Set olkApp = Outlook.Application
    For Each acct In olkApp.Session.Accounts
        Debug.Print acct.SmtpAddress
    Next
 
End Sub

Open in new window

0
 
BigBadWolf_000Author Commented:
I ran the macro....in the VB Editor....it runs....nothing is output or displayed...
ran it in "this outlook session" and Module1....not result (see image below)
0
 
Chris BottomleyCommented:
No offence ... the immediate window ctrl  + G to display
0
 
BigBadWolf_000Author Commented:
Duh! thanks... :D

It returns the email address associated with the different pop3 accounts....so I have four pop accounts.....just returns the email address for each...I dont want to post the email address here

ssss@domain1.com
dddd@domain2.com
aaaa@domain3.com
zzzz@domain4.com
0
 
BigBadWolf_000Author Commented:
the number 4 position is the one associated with the account in question
 
0
 
Chris BottomleyCommented:
Understood ... i'll put a constant in that you'll have to set up for the account itself
0
 
BigBadWolf_000Author Commented:
sure not a problem....thanks
0
 
Chris BottomleyCommented:
While I think about it.  In your outlook insert a new code module and put this line of code in:

Public Const Your_MailAccount_Name = "zzzz@domain4.com"

In this way this sensitive data is aved and if you need to copy the code to me it won't accidently get uploaded ... therefore don't put any code I supply in this same module use a second new code module for that purpose.

Chris
0
 
Chris BottomleyCommented:
>>> if to @xxx.com then put sent msg in folder Company\xcorp\sent

Presumably I would be correct to say:
if to @xxx.com then put sent msg in folder Company\xxx\sent

But where is the root folder ... i.e. the folderpath.
PLace the cursor on the 'root' for the company folder and press enter on the following in the command line:

?application.ActiveExplorer.CurrentFolder.FolderPath

should be something like:
\\Personal Folders\Inbox\Company

Chris
0
 
Chris BottomleyCommented:
FYI

I have draft code to do this which seems ok to me but is pending the correct folder path construct to finish adapting for your use.

Chris
0
 
BigBadWolf_000Author Commented:
got it will do - Public Const Your_MailAccount_Name = zzzz@domain4.com

@xxx.com then put sent msg in folder Company\xxx\sent would be fine
Path for sent messg folder for @xxx.com  = \\Personal Folders\Company\xxx\sent





0
 
Chris BottomleyCommented:
APologies I cannot fully test the code now but I tested as far as possible last night so place the following two subs into the new module ... the one without the public constant.

Now we need to execute the code.  In 'thisoutlooksession' in teh VBE select application and ItemSend.  In this sub add the line:

    checkPop Item

Now when you send an email that meets the criteria it should be moved as requested.  Let me know how it goes of course.

Chris
Sub checkPop(mai As mailitem)
Dim olkApp As Application
Dim cpy As String
Dim saveFolder As String
'Your_MailAccount_Name  is the account being analysed
 
    If mai.SendUsingAccount = Your_MailAccount_Name Then
        cpy = mai.Recipients.Item(1).Address & ";"
        cpy = Left(cpy, InStr(cpy, ";") - 1)
        cpy = Mid(cpy, InStr(cpy, "@") + 1)
        cpy = Left(cpy, InStr(cpy, ".") - 1)
        '\Personal Folders\Company\xxx\sent
        saveFolder = "\Personal Folders\Company\" & cpy & "\sent"
        mai.SaveSentMessageFolder = olNav2Folder(saveFolder, True)
    End If
 
End Sub
 
Public Function olNav2Folder(foldername As String, Optional createFolders As Boolean) As Object
Dim olApp As Object
Dim olNs As Object
Dim olfldr As Object
Dim reqdFolder As Object
Dim arrFolders() As String
Dim nestCount As Integer
 
    On Error Resume Next
    foldername = Replace(Replace(foldername, "/", "\"), "\\", "")
    If Right(foldername, 1) = "\" Then foldername = Left(foldername, Len(foldername) - 1)
    arrFolders() = Split(foldername, "\")
    Set olApp = CreateObject("Outlook.Application")
    Set olNs = olApp.GetNamespace("MAPI")
    Set reqdFolder = olNs.folders.Item(arrFolders(0))
    For nestCount = 1 To UBound(arrFolders)
        If Not reqdFolder Is Nothing Then
            Set olfldr = reqdFolder.folders
            Set reqdFolder = olfldr.Item(arrFolders(nestCount))
            If reqdFolder <> olfldr.Item(arrFolders(nestCount)) Then
                If createFolders Then
                    reqdFolder.folders.Add (arrFolders(nestCount))
                    Set olfldr = reqdFolder.folders
                    Set reqdFolder = olfldr.Item(arrFolders(nestCount))
                Else
                    Set reqdFolder = Nothing
                    Exit For
                End If
            End If
        Else
        End If
    Next
    Set olNav2Folder = reqdFolder
    Set olApp = Nothing
    Set olNs = Nothing
    Set olfldr = Nothing
    Set reqdFolder = Nothing
End Function

Open in new window

0
 
BigBadWolf_000Author Commented:

Did in thisOutlooksession...

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
checkPop Item
End Sub

Module 1...
Public Const Your_MailAccount_Name = "support@abc.com"

Module 2...
In path:        
your two subs, changed Company to ABC (folder in outlook is upper case so matched it)
changed 'sent' to 'Sent' (folder in outlook 'S' upper case so matched it)
saveFolder = "\Personal Folders\ABC\" & cpy & "\Sent"

In Outlook...
Made sure if recepients email is zzz@mydomain.com
then set sub-company folder name to mydomain (lowercase)

Sent email to zzz@mydomain.com from account support@abc.com
did above for another recipient with different domain

Did not work....message went to default Outlook Sent Items folder

-----------------------------------------

Just to test I tried using the pop account name as it appears in Outlook ...account properties....more settings....account name.

i.e. ABCcorp

got results below...

Error...

Run-time error '13':
Type mismatch

On Debug...
mai.SaveSentMessageFolder = olNav2Folder(saveFolder, True)

-----------------------------------------

Hope this helps, and thank you very much for staying with this.
0
 
BigBadWolf_000Author Commented:
For visual reference...

Snap1.jpg
0
 
Chris BottomleyCommented:
saveFolder = "\Personal Folders\ABC\" & cpy & "\Sent
should be
saveFolder = "\\Personal Folders\ABC\" & cpy & "\Sent

Any change?
0
 
BigBadWolf_000Author Commented:
made change (added extra  \) ...tested ....did not work

0
 
Chris BottomleyCommented:
OOPS!

Replace
        mai.SaveSentMessageFolder = olNav2Folder(saveFolder, True)
with
        mai.SaveSentMessageFolder = olNav2Folder(saveFolder)

Chris
0
 
BigBadWolf_000Author Commented:
Made change, Did not work....
0
 
Chris BottomleyCommented:
OOPS 2!

Replace
        mai.SaveSentMessageFolder = olNav2Folder(saveFolder)
with
        set mai.SaveSentMessageFolder = olNav2Folder(saveFolder)

Chris
0
 
BigBadWolf_000Author Commented:
Did that, unfortunately did not work....
0
 
Chris BottomleyCommented:
In what way didn't work, ay relevant info?
0
 
Chris BottomleyCommented:
Also examine the company etc in the potential  folder names for invalid characters:

Invalid Chars in Outlook:     / \ * ? < >
Invalid Chars in Exchange: / \ * ? < > | " ; : + [ ] & ~
Invalid Chars in OWA:        / \ * ? < > | " ; : + [ ] & ~ . #

Chris
0
 
BigBadWolf_000Author Commented:
Using outlook as a client no exchange involved.....when I send a message via AccountA the message ends up in the default 'Sent Items' folder no errors popup.
folder names have no invalid characters...they follow the email domain so there are no spaces...however one does have a -   i.e. xyz-asdf  ....but its does not work for any of the others either.
is there a way to log the actions of the macro to see whats happening???
0
 
Chris BottomleyCommented:

Is the new folder created
0
 
BigBadWolf_000Author Commented:
by the script...no...I already have the folders manually created...
\\Personal Folders\ABC\mydomain\Sent
0
 
BigBadWolf_000Author Commented:
Did it...no luck...did not work...same results as before.

Chris, are you testing with a POP account on Outlook 2007?


0
 
Chris BottomleyCommented:
Absolutely.

Try deleting the specific sub folder ... when working the script will create the folder unde company.  It will then give some evidence to work off.

Chris
0
 
BigBadWolf_000Author Commented:
Deleted the sub folder under company....no effect....script did not create sub folder and sent item remains in Sent Items folder.
Does your script wait for the message to go to Sent Items folder and then move it to the desired folder? if not ...maybe thats a direction that may work.
The reason I say that is cause I downloaded a trial version of the commercial sw I mentioned in the above posts. Its a plugin not a vb module.I notice the sent message first goes to the Sent Items folder and a second later it is moved to the desired folder.
0
 
Chris BottomleyCommented:
'my' solution actually changes the email as part of the send action so that it is saved straight away to the required folder.  I will repost the code now to 'stop as soon as it's triggered so let's see if it runsd at all!

If it stops then press F8 time and again and see which lines of code are executed.

Chris
Sub checkPop(mai As mailitem)
Dim fldr As Object
Dim olkApp As Application
Dim cpy As String
Dim saveFolder As String
'Your_MailAccount_Name  is the account being analysed
 
    Stop
    If LCase(mai.SendUsingAccount) = LCase(Your_MailAccount_Name) Then
        cpy = mai.Recipients.Item(1).Address & ";"
        cpy = Left(cpy, InStr(cpy, ";") - 1)
        cpy = Mid(cpy, InStr(cpy, "@") + 1)
        cpy = Left(cpy, InStr(cpy, ".") - 1)
        '\Personal Folders\Company\xxx\sent
        saveFolder = "\\Personal Folders\Company\" & cpy & "\sent"
        Set fldr = olNav2Folder(saveFolder, True)
        Set mai.SaveSentMessageFolder = fldr
    End If
 
End Sub

Open in new window

0
 
BigBadWolf_000Author Commented:
Did it ...same results
I have the images in exact sequence of what line it runs after each F8 starting with Stop....


F8-1.JPG
F8-2.JPG
F8-3.JPG
F8-4.JPG
F8-5.JPG
0
 
Chris BottomleyCommented:
So the mail account name isn't being detected ... it's nnot ther case as that is forced to low.

SInce you cannot advise the mail account you need to double check the definition of your_mailaccount_name in teh public file.

When the code stops on that line type in the immediate window:

?mai.SendUsingAccount
then
?Your_MailAccount_Name

And line the two outpus up and see where they are different.

Chris
0
 
BigBadWolf_000Author Commented:
IT WORKS!!! it was the 'Your_MailAccount_Name' constant....

A summary of why...for reference...

"To identify the correct definition can you run this macro..."
This script provided the email address of AccountA (aaa@mydomain.com)
So we used...
Public Const Your_MailAccount_Name = "aaa@mydomain.com"

In my message "04/17/09 09:18 AM, ID: 24169361" I mentioned...
"Just to test I tried using the pop account name as it appears in Outlook ...account properties....more settings....account name."
But this caused an error cause the script had a few ooops' at the time

I never tried that again...till I saw your latest post and changed the public constant to....
Public Const Your_MailAccount_Name = "AccountA"
AccountA is the name given to the account in "more Settings" in account properties..see image below.

It works great......THANK YOU,THANK YOU,THANK YOU,THANK YOU,THANK YOU,THANK YOU, VERY MUCH...You are AWESOME...and thanks for being patient and staying with me on it. I am estatic.

Snap3.jpg
0
 
BigBadWolf_000Author Commented:
Thank You!!!
0
 
Chris BottomleyCommented:
Steady on! ... you'll burst a blood vessel ;o)

Glad to help in the end and sorry it took so long to close it out but I have learned, (I hope) to allow for the displayed name.

Chris
0
 
BigBadWolf_000Author Commented:
hahahhahahahhah....in the words of Maya Angelou....All great achievements require time...I learnt a lot too... :)
0
All Courses

From novice to tech pro — start learning today.