Help with VBA - save sent to folder and SentItems

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?

Code:

---

Dim WithEvents colSentItems As Items

---

Code:

---

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

---

Code:

---

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

---

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

Quote:

---

Originally Posted by westconn1

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?

;-)

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

Code:

---

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

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

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

Code:

---

Private Sub colSentItems

---

to ...

Code:

---

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!