Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If Not Item.Class = olMail Then GoTo fin
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If TypeName(objFolder) = "Nothing" Then
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = Item.SaveSentMessageFolder
End If
Set Item.SaveSentMessageFolder = objFolder
fin:
End Sub