Copy sent mail to a folder or a folder in an archive

[Florian]

After having sent a mail I would like to get the possibility to save a copy of the sent mail in the folder I choose (next to the normal way of storing sent mails in the sent mails system folder); similar to the behavior of Lotus.

For that I found a solution at: www*.*outlookcode.*com/*d/*code/*setsavefolder.*htm. The code describes how to solve my question as long as the target folder is within the .pst file.

Actually I have made use of the code successfully quite a while.

After I reached the 1 GB limit of my mailbox I started to move several folders from my .pst file to individual archives (I do not want to work with date related archiving). Up to now I have 7 of such individual archive files, some holding just one folder, other up 20 folders. For the moved subjects (folders) i do not work with folders within the .pst anymore, just with the archived folders.

I recently discovered that the code shown at the link shown above does NOT work with folders in archives. It just exits without any message, but also without copying the message.

How can the code be extended so that it will also work with a (number of) folders in a (number of) archive files? Or what could be a different approach to solve my problem?

I am using Outlook 2007 on an Win XP machine.

Thanks for your support and best regards,


Florian

P.S. On October 24 I posted that question also at www*.*outlookcode.*com/*threads.*aspx?*forumid=*2&*messageid=*32382
Unfortunately i did not receive a reply yet.
I tried to post the link as working URL (as advised in the sticky crossposting message on this forum) but as a newbie am yet banned to do so. I had to add several asterisks to avoid the URL would be discovered by the parser.

[Crocus Crow]

Use AddStore to add an archive .pst file to the current profile and then you can add a sent message to a folder within the archive:

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

Dim olNameSpace As NameSpace
Dim olArchiveFolder As Outlook.MAPIFolder
Dim pstFile As String

pstFile = "c:\path\to\archive_file.pst"

Set olNameSpace = GetNamespace("MAPI")
olNameSpace.AddStore (pstFile)
Set olArchiveFolder = olNameSpace.Folders("Archive Folders").Folders("sub folder")
Set Item.SaveSentMessageFolder = olArchiveFolder
olNameSpace.RemoveStore olArchiveFolder

End Sub

[Florian]

i have played a bit with the code and this is what i made out of it:



Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objNS As NameSpace
Dim objFolder As MAPIFolder

If Item.Class = olMail Then

Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If TypeName(objFolder) <> "Nothing" Then
If objFolder.Class = olFolder Then
Set Item.SaveSentMessageFolder = objFolder
End If
End If
Set objFolder = Nothing
Set objNS = Nothing

End If

End Sub

actually i have no clue why it works. the initial code is much more complex and tests for more elements.

what i have noticed is that now the sent mail is only stored in the picked folder. if i remember well, the initial code saved the sent mail in the sent mail folder plus a copy in the picked folder. this seems not to work anymore.

i still would be curious to learn whether the new, reduced code holds major flaws. thanks, florian

[JP2112]

If you want a copy in your Sent Items PLUS a copy in your chosen folder, you'll need to make a copy of it.

Try something like this:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim msg As MailItem

If Item.Class = olMail Then

Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If TypeName(objFolder) <> "Nothing" Then
If objFolder.Class = olFolder Then
Set Item.SaveSentMessageFolder = objFolder
Set msg = Item.Copy
msg.Move objNS.GetDefaultFolder(olFolderSentMail)
End If
End If
Set objFolder = Nothing
Set objNS = Nothing

End If

End Sub

[kenburenga]

I too am trying to write a Macro that saves outgoing e-mail to my “FollowUp” folder instead of my “Sent Items”. The Macro is to be run after opening and composing a New E-mail message, but before it is sent.

My code is as follows.

Sub Folder()
Set objMail = Application.ActiveInspector.CurrentItem
Dim myNamespace As NameSpace
Dim objFolder As MAPIFolder
Set myNamespace = Application.GetNamespace("MAPI")
Set objFolder = myNamespace.Folders("FollowUp")
Set Item.SaveSentMessageFolder = objFolder
Set myNamespace = Nothing
Set objFolder = Nothing
End Sub

The code halts on
Set objFolder = myNamespace.Folders("FollowUp")
with “An object could not be found” message.

Can someone please help me solve this.