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