Microsoft Office Forums - View Single Post - [Solved] VBA to move selected emails or conversation to current year pst folder

webharvest · 08-14-2015, 04:18 PM

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.

Code:

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
        Next
    Else
        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