Solved: Moving Sent EMail

[JKwan]

What I want to achieve is that when I sent an Email with a particular subject, once sent, then move this sent email to a particular folder. I am able to do this without problem, but I have two copies of it, one in the Sent Folder, the other in my "move" folder. Can I directly move this into my Folder, instead of having one also reside in my Sent Folder? Thank you for your assistance. Here is the code that I am using.

If InStr(1, Item.Subject, "Approved") > 0 Then
Set myNameSpace = Application.GetNamespace("MAPI")
If InStr(1, Item.Body, "WellcoreFacilities-App") > 0 Or _
InStr(1, Item.Body, "CTX_Wellcore_Facilities") > 0 Then
Item.Move myNameSpace.Folders("PipelineSupport").Folders("Facilities").Folders("Accounts")
Else
Item.Move myNameSpace.Folders("PipelineSupport").Folders("Pipeline Compliance").Folders("Accounts")
End If
Set myNameSpace = Nothing
End If

[MVFC]

Yes, there is a way to do it. You must use the property SaveSentMessageFolder of the mail message you are going to send. As I think you would like to store your sent messages in different folders, depending on the subject, recipient etc., the easyest way to do it is to select the folder where you want the message to be saved after sending, BEFORE starting composing your message. So this will be the Currentfolder of the ActiveExplorer whilst you write your message.
Then you can send to it the saved copy of your message running this code:


Dim eMail As MailItem

Set eMail = ActiveInspector.CurrentItem
Set eMail.SaveSentMessageFolder = ActiveExplorer.CurrentFolder


You can put this under a dedicated button, but you can also create a second "Send" button having the statement 'eMail.Send' after the 3 lines above. This way you will be able to choose for each message you send whether you want to save it in the deafult Sent Items folder or in another folder of your choice.

But of course you can integrate the 'Set eMail.SaveSentMessageFolder'-statement in your own code, if you do not need flexibility.
Then your code could look, for example, like this:


Dim myNamespace As NameSpace
Dim fldFac As MAPIFolder
Dim fldComp As MAPIFolder

Set myNamespace = Application.GetNamespace("MAPI")
Set fldFac = myNamespace.Folders("PipelineSupport").Folders("Facilities").Folders("Accounts")
Set fldComp = myNamespace.Folders("PipelineSupport").Folders("Pipeline Compliance").Folders("Accounts")

With Item
If InStr(1, .Subject, "Approved") > 0 Then
If InStr(1, .Body, "WellcoreFacilities-App") > 0 Or _
InStr(1, .Body, "CTX_Wellcore_Facilities") > 0 Then
Set .SaveSentMessageFolder = fldFac
Else
Set .SaveSentMessageFolder = fldComp
End If
End If
End With
Set myNamespace = Nothing
Set fldFac = Nothing
Set fldComp = Nothing



Also in this case, however, you will have to run the macro AFTER creating the Item and BEFORE sending it. Therefore a new 'Send'-button still could be a good solution.

Hope this helps!

[JKwan]

MVFC:
Thank you for the pointers.