Consulting

Results 1 to 5 of 5

Thread: Filing Sent Items

  1. #1

    Filing Sent Items

    Hello,

    We currently have a macro on our Outlook here at work that prompts the user to select a folder to save a sent item in a selected folder each time they click send. I didn't write this code and i have to confess that I know nothing about VBA in Outlook (I'm more of an Excel man).

    I have been asked to see if I can change the macro so that as well as saving the sent item in the selected folder, a copy is also placed in the sent items folder so that people can easily view a list of all items sent.

    Can anyone please tell me what needs to be added to this code in order to achieve this:

    Dim WithEvents colSentItems As Items
    
    Private Sub Application_Startup()
    
        Dim ns As Outlook.NameSpace
        
        Set ns = Application.GetNamespace("MAPI")
       
    '   Set event handler on the sent items folder to monitor when new items are saved to the folder
        Set colSentItems = ns.GetDefaultFolder(olFolderSentMail).Items
       
        Set ns = Nothing
        
    End Sub
    
    Private Sub colSentItems_ItemAdd(ByVal Item As Object)
    
        Dim objNS As NameSpace
        Dim objFolder As MAPIFolder
    
    '   This is fired every time an item is added to the Sent Items Folder
        If Item.Class = olMail Then
        
    '   Only do this if the item is a sent email, ignore meeting requests etc.
        Set objNS = Application.GetNamespace("MAPI")
        Set objFolder = objNS.PickFolder
            Do While objFolder Is Nothing
                Set objFolder = objNS.PickFolder
            Loop
        If TypeName(objFolder) = "MAPIFolder" Then
                If Not objFolder = objNS.GetDefaultFolder(olFolderSentMail) Then
    '               move email to the selected folder
                    Item.Move objFolder
                End If
        End If
            
        Set objFolder = Nothing
        Set objNS = Nothing
            
        End If
    
    End Sub
    Thanks

  2. #2
    If you want to leave a copy in the Sent Items folder, then you need to create a copy of the message and move that to the selected folder:

    Option Explicit
    
    Private WithEvents colSentItems As Items
     
    Private Sub Application_Startup()
        Dim ns As Outlook.NameSpace
        Set ns = Application.GetNamespace("MAPI")
         '   Set event handler on the sent items folder to monitor when new items are saved to the folder
        Set colSentItems = ns.GetDefaultFolder(olFolderSentMail).Items
        Set ns = Nothing
    End Sub
    
    Private Sub colSentItems_ItemAdd(ByVal Item As Object)
    
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
    Dim oCopiedItem As MailItem
    
        '   This is fired every time an item is added to the Sent Items Folder
        If Item.Class = olMail Then
            Set oCopiedItem = Item.Copy
    
            '   Only do this if the item is a sent email, ignore meeting requests etc.
            Set objNS = Application.GetNamespace("MAPI")
            Do While objFolder Is Nothing
                Set objFolder = objNS.PickFolder
            Loop
            If TypeName(objFolder) = "MAPIFolder" Then
                If Not objFolder = objNS.GetDefaultFolder(olFolderSentMail) Then
                    '               move email to the selected folder
                    oCopiedItem.Move objFolder
                End If
            End If
            Set objFolder = Nothing
            Set objNS = Nothing
        End If
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Works perfectly. Thanks gpmayor

  4. #4
    You could just create a search folder that searches for messages sent by the user and add that to the favorites in place of the standard 'sent items' folder. I think that has the advantage of avoiding creating duplicate copies of the mails, so it will keep your PST file size down

  5. #5
    VBAX Newbie
    Joined
    Feb 2020
    Posts
    2
    Location

    Filing Sent Items - Multiple Accounts

    I have 2 email accounts (actually 3 if you count my gmail). This only works for 1 of my outlook accounts. How can I get this to work with the other outlook account (and gmail if possible).

    Quote Originally Posted by gmayor View Post
    If you want to leave a copy in the Sent Items folder, then you need to create a copy of the message and move that to the selected folder:

    Option Explicit
    
    Private WithEvents colSentItems As Items
     
    Private Sub Application_Startup()
        Dim ns As Outlook.NameSpace
        Set ns = Application.GetNamespace("MAPI")
         '   Set event handler on the sent items folder to monitor when new items are saved to the folder
        Set colSentItems = ns.GetDefaultFolder(olFolderSentMail).Items
        Set ns = Nothing
    End Sub
    
    Private Sub colSentItems_ItemAdd(ByVal Item As Object)
    
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
    Dim oCopiedItem As MailItem
    
        '   This is fired every time an item is added to the Sent Items Folder
        If Item.Class = olMail Then
            Set oCopiedItem = Item.Copy
    
            '   Only do this if the item is a sent email, ignore meeting requests etc.
            Set objNS = Application.GetNamespace("MAPI")
            Do While objFolder Is Nothing
                Set objFolder = objNS.PickFolder
            Loop
            If TypeName(objFolder) = "MAPIFolder" Then
                If Not objFolder = objNS.GetDefaultFolder(olFolderSentMail) Then
                    '               move email to the selected folder
                    oCopiedItem.Move objFolder
                End If
            End If
            Set objFolder = Nothing
            Set objNS = Nothing
        End If
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •