Send and File - Help

[krishhi]

I got a macro which can move the mails from sent folder to the user specified. It is working great.

But, I want a copy of sent mail in sent folder. Is there any way to do this?

Below is the macro, which can send the mail and move to the specific user defined folder but not keeping a copy of the sent mail.


Private Sub Application_ItemSend(ByVal Item As Object, _
Cancel As Boolean)
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If TypeName(objFolder) <> "Nothing" And _
IsInDefaultStore(objFolder) Then
Set Item.SaveSentMessageFolder = objFolder
End If
Set objFolder = Nothing
Set objNS = Nothing
End Sub
Public Function IsInDefaultStore(objOL As Object) As Boolean
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objInbox As Outlook.MAPIFolder
On Error Resume Next
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Select Case objOL.Class
Case olFolder
If objOL.StoreID = objInbox.StoreID Then
IsInDefaultStore = True
End If
Case olAppointment, olContact, olDistributionList, _
olJournal, olMail, olNote, olPost, olTask
If objOL.Parent.StoreID = objInbox.StoreID Then
IsInDefaultStore = True
End If
Case Else
MsgBox "This function isn't designed to work " & _
"with " & TypeName(objOL) & _
" items and will return False.", _
, "IsInDefaultStore"
End Select
Set objApp = Nothing
Set objNS = Nothing
Set objInbox = Nothing
End Function


Thanks in Advance,

[Sebastian H]

Just use Item.Copy. See the help for that method for a nice example that fits to your case.

[krishhi]

Just use Item.Copy. See the help for that method for a nice example that fits to your case.

Thanks for the reply, where can i add this? Sorry, I am not familiar with VBA.

[skatonni]

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

Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim myCopiedItem As Object

Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder

If TypeName(objFolder) <> "Nothing" And IsInDefaultStore(objFolder) Then
Set myCopiedItem = Item.Copy
myCopiedItem.Move objFolder
End If

Set objFolder = Nothing
Set objNS = Nothing

End Sub

[krishhi]

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

Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim myCopiedItem As Object

Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder

If TypeName(objFolder) <> "Nothing" And IsInDefaultStore(objFolder) Then
Set myCopiedItem = Item.Copy
myCopiedItem.Move objFolder
End If

Set objFolder = Nothing
Set objNS = Nothing

End Sub


First of all i am very sorry for my late reply.

It is working great. Thank you so much for you help.

Is there any way to apply this macro to a Microsoft Exchange Server folder, I tried, but it seems not working with the Microsoft Exchange Server folder.

Do you have any idea?

Best Regards,

Krishhi