Help with VBA - save sent to folder and SentItems

[Stew]

Hi folks,
I've got a bit of experience with VBA (Excel & Access 2003) but new to Outlook (and Office 2013).

Our office has just transitioned over from Lotus Notes and one of my colleagues wants to replicate the Notes way of saving outgoing emails to a folder. In Notes the email is saved to the specified folder AND to the Sent Items folder.

I've pieced together the following from bits of VBA I found but I'm having an issue. The procedure uses ItemAdd to monitor mail items added to the SentItems folder. After an email is sent the procedure runs and a dialogue asks the user if they want to "Save to another folder". Choosing yes opens the folder picker and after choosing the folder the email is successfully copied to that folder. Great! But the problem is the procedure then loops and wants to save the email again and I can't figure out why it is doing this. Hope someone can help?



Dim WithEvents colSentItems As Items




Private Sub Application_Startup()
Dim NS As Outlook.NameSpace
Set NS = Application.GetNamespace("MAPI")
Set colSentItems = NS.GetDefaultFolder(olFolderSentMail).Items
Set NS = Nothing
End Sub




Private Sub colSentItems_ItemAdd(ByVal Item As Object)
Dim myCopiedItem As Outlook.MailItem
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim Response
If Item.Class = olMail Then
Response = MsgBox("Save to another folder?", vbYesNo)
If Response = vbYes Then
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If Not objFolder Is Nothing Then
Set myCopiedItem = Item.Copy
myCopiedItem.Move objFolder
End If
End If
End If
Set myCopiedItem = Nothing
Set objFolder = Nothing
Set objNS = Nothing
End Sub

[westconn1]

possibly
Set myCopiedItem = Item.Copy
adds an item to the sent items collection, before it is moved to the chosen folder, causing the event to fire again

i guess i would have just saved the additional copy in the itemsend event

[Stew]

i guess i would have just saved the additional copy in the itemsend event


Thanks westconn1, I'll have a look at itemsend ... unless you wanna give a newbie a break and show me how?

;-)

[westconn1]

mostly the same code should work, no requirement for withevents or startup


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

i doubt it will care about the additional item, so the code should only run the once

to make your current code work, try using a boolean variable to prevent the code running twice

[Stew]

Thanks again westconn1. I'll try that out at work tomorrow.

[Stew]

Didn't get back to this until after an extended Easter break ...
Just wanted to say that westconn1's solution worked perfectly! Change

Private Sub colSentItems to ...

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) ... and it works like a dream. No need for the withevents or startup code either as westconn1 mentioned.

Thanks westconn1!