VBA to move selected emails or conversation to current year pst folder RRS feed

  • Question

  • I just upgraded to Outlook 2013. I had some vba code to move selected emails to a reference pst folder by year. So how it worked was it would look at the date on the emails I had selected when I ran the macro and it would store it in a reference pst folder that I would create at the beginning of every year (2015_Reference_Files). Now that I'm running Outlook 2013 the macro runs but doesn't move the files. I'm hoping someone knows what the new syntax is for Outlook 2013. Ideally I would like it to move all the files in a conversation if I have a conversation selected and also work if I have a number of emails selected. I'm new to outlook 2013 and the conversation view.

    Any help would be greatly appreciated. Below is the code I had before that worked great in Outlook 2007 on just messages not conversations.

    Sub MoveSelectedMessagesToCurrentPST()
        MoveSelectedMessagesToPSTFolder (Year(Now()) & "_Reference_Files")
    End Sub
    Sub MoveSelectedMessagesToPSTFolder(PSTName As String) ', FolderName As String
    On Error Resume Next
    'On Error Resume Next
    '    Dim objFolder As Outlook.MAPIFolder
    '    Dim objInbox As Outlook.MAPIFolder
    '    Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
    '    Dim objTopFolder As Outlook.MAPIFolder
    '    Dim objNextFolder As Outlook.MAPIFolder
        Dim objTargetFolder As Outlook.MAPIFolder
        Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
    '    Set objNS = Application.GetNamespace("MAPI")
    '    Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
    '    Set objFolder = objInbox.Folders(PST_FolderName)
        Set objNS = Application.GetNamespace("MAPI")
    '    Set objTopFolder = objNS.Folders(PSTName).Folders(FolderName)
    '    Set objNextFolder = objTopFolder.Folders("Systems")
    '    Set objTargetFolder = objNextFolder.Folders("Outlook")
        Set objTargetFolder = objNS.Folders(PSTName) '.Folders(FolderName)
    'Assume this is a mail folder
        If objTargetFolder Is Nothing Then
            MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
        End If
        If Application.ActiveExplorer.Selection.Count = 0 Then
            'Require that this procedure be called only when a message is selected
            Exit Sub
        End If
            If Application.ActiveExplorer.Selection(1).Class = 43 Then
        ' 43 is the literal constant for a mail item
        ' sometimes a calendar item is in the inbox, in which case there is a type
        ' conflict with the objItem variable, which is declared as a mail item.
            For Each objItem In Application.ActiveExplorer.Selection
                If objFolder.DefaultItemType = olMailItem Then
                    If objItem.Class = olMail Then
                        objItem.UnRead = False
                        objItem.Move objTargetFolder
                    End If
                End If
            MsgBox ("This is not a message; it may be a calendar request")
        End If
        Set objItem = Nothing
        Set objFolder = Nothing
    '    Set objInbox = Nothing
        Set objNS = Nothing
     End Sub

    I code for fun not for a living at Connect Christian Church near Cincinnati Ohio (

    Friday, August 14, 2015 11:07 PM


  • Hello,

    Don't use multiple dots in the single line of code. Each time you call a property or method - you get a new object instance. For example:

    For Each objItem In Application.ActiveExplorer.Selection

    Declare each object and get the property or method value on a separate line of code.

    Also I'd suggest using the for loop instead.

    To get all items in the conversation use the GetConversation method of Outlook items which obtains a Conversation object that represents the conversation to which this item belongs. Then you can use the GetTable method which returns a Table object that contains rows that represent all items in the conversation. For example:

    Sub DemoConversationTable() 
     Dim oConv As Outlook.Conversation 
     Dim oTable As Outlook.Table 
     Dim oRow As Outlook.Row 
     Dim oMail As Outlook.MailItem 
     Dim oItem As Outlook.MailItem 
     Const PR_STORE_ENTRYID As String = _ 
     On Error Resume Next 
     ' Obtain the current item for the active inspector. 
     Set oMail = Application.ActiveInspector.CurrentItem 
     If Not (oMail Is Nothing) Then 
     ' Obtain the Conversation object. 
     Set oConv = oMail.GetConversation 
     If Not (oConv Is Nothing) Then 
     Set oTable = oConv.GetTable 
     oTable.Columns.Add (PR_STORE_ENTRYID) 
     Do Until oTable.EndOfTable 
     Set oRow = oTable.GetNextRow 
     ' Use EntryID and StoreID to open the item. 
     Set oItem = Application.session.GetItemFromID( _ 
     oRow("EntryID"), _ 
     Debug.Print oItem.Subject, _ 
     "Attachments.Count=" & oItem.Attachments.count 
     End If 
     End If 
    End Sub 
    Finally, you may find the MarkAsUnread and MarkAsRead methods of the Conversation class helpful.

    Saturday, August 15, 2015 9:08 AM