locked
Problem With VBA To Move Mail To Junk Folder RRS feed

  • Question

  • Hi all.  Hoping to get some help with the appropriate VBA to move messages being viewed through an Outlook Search Folder. 

    I have created (via liberal plagiarism of VBA found online) a macro that will (1) mark a selected message as read, (2) assign the category "Junk", and (3) move it to the "Junk E-Mail" folder of the current account.  This macro is used in an Outlook environment with multiple Exchange accounts, so it is important that the message is moved to the appropriate Junk E-Mail folder (which is often not the Junk E-Mail folder of the default account). 

    The macro works fine unless I am viewing mail via an Outlook Search Folder as opposed to an actual mail folder.  So if I am viewing my mail using the Unread Mail search folder, then the macro fails when I run it.  I'm guessing that for VBA purposes, the search folders are not children of the top-level message store in the same way that the Inbox (or subfolder of the Inbox) is.  I am hoping that someone can suggest some changes to my macro so that it will work if I am viewing mail via a search folder as well as a regular folder.  Thanks in advance for your help.

    Sub JunkToJunk()
    'Based on work of verychewy and Caleb O
    'modified by Gurs
    
    On Error Resume Next
    Err.Clear
    
        Dim objNS As Outlook.NameSpace
        Dim thisFolder As Outlook.MAPIFolder
        Dim midFolder As Outlook.MAPIFolder
        Dim folderRoot As Outlook.MAPIFolder
        Dim objFolder As Outlook.MAPIFolder
        Dim objItem As Outlook.MailItem
    
        Set objNS = Application.GetNamespace("MAPI")
        'Assume this is a mail folder
        Set thisFolder = Application.ActiveExplorer.currentFolder
        Set folderRoot = thisFolder.Parent
        
    'subroutine to check if at top of info store
    RootCheck:
        If Err Then
            'folderRoot is top of info store, all good
            Err.Clear
        Else
            'folderRoot is buried, go up one more level
            Set midFolder = folderRoot.Parent
            Set folderRoot = midFolder.Parent
            GoTo RootCheck
        End If
        
        Set objFolder = folderRoot.Folders("Junk E-mail")
        'This will fail if Junk E-Mail is not a direct child of the top-level message store
        
        'Be sure target folder exists
        If objFolder Is Nothing Then
            MsgBox "This folder doesn’t exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
            Exit Sub
        End If
        
        'Require that this procedure be called only when a message is selected
        If Application.ActiveExplorer.Selection.Count = 0 Then
            Exit Sub
        End If
          
        For Each objItem In Application.ActiveExplorer.Selection
            If objFolder.DefaultItemType = olMailItem Then
                If objItem.Class = olMail Then
                    objItem.UnRead = False
                    objItem.Categories = "Junk"
                    objItem.Move objFolder
                End If
            End If
        Next
        
        Set objNS = Nothing
        Set thisFolder = Nothing
        Set midFolder = Nothing
        Set folderRoot = Nothing
        Set objFolder = Nothing
        Set objItem = Nothing
    
    End Sub

    Friday, February 22, 2013 8:30 PM

Answers

  • Retrieve the parent folder of the message from the MailItem.Parent property, then open the parent Store using MAPIFolder.Store, then open the Junk Mail folder of that store using Store.GetDefaultFolder(olFolderJunk).

    Dmitry Streblechenko (MVP)
    http://www.dimastr.com/redemption
    Redemption - what the Outlook
    Object Model should have been
    Version 5.4 is now available!

    • Marked as answer by Quist Zhang Tuesday, February 26, 2013 5:47 AM
    Friday, February 22, 2013 8:34 PM
  • What do you mean by "Outlook always thinks that the target folder does not exist"? Do you get an error? What is it?

    If the search folder spans multiple stores, you will need to retrieve the parent folder store on the per item basis:

    Set thisFolder =  objItem.Parent
    Set objStore = thisFolder.MAPIFolder.Store
    Set objFolder = objStore.GetDefaultFolder(olFolderJunk)


    Dmitry Streblechenko (MVP)
    http://www.dimastr.com/redemption
    Redemption - what the Outlook
    Object Model should have been
    Version 5.4 is now available!


    Monday, February 25, 2013 8:32 PM
  • Thanks!  After I posted I kept playing with it, and I got it working before I saw your last post.  Final version below.  The definition of thisFolder and objStore look a little different in my version than in your last post, but apparently not enough to derail the macro. 

    Sub JunkToJunk()
    'Based on work of verychewy and Caleb O
    'modified by Gurs
    
    On Error Resume Next
    
        Dim thisFolder As Outlook.MAPIFolder
        Dim objFolder As Outlook.MAPIFolder
        Dim objItem As Outlook.MailItem
        Dim objStore As Store
    
        Set thisFolder = Application.ActiveExplorer.currentFolder
        Set objStore = thisFolder.Store
        Set objFolder = objStore.GetDefaultFolder(olFolderJunk)
        
        'Be sure target folder exists
        If objFolder Is Nothing Then
            MsgBox "This folder doesn’t exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
            Exit Sub
        End If
        
        'Require that this procedure be called only when a message is selected
        If Application.ActiveExplorer.Selection.Count = 0 Then
            Exit Sub
        End If
          
        For Each objItem In Application.ActiveExplorer.Selection
            If objFolder.DefaultItemType = olMailItem Then
                If objItem.Class = olMail Then
                    objItem.UnRead = False
                    objItem.Categories = "Junk"
                    objItem.Move objFolder
                End If
            End If
        Next
        
        Set thisFolder = Nothing
        Set objFolder = Nothing
        Set objItem = Nothing
        Set objStore = Nothing
    
    End Sub

    • Marked as answer by Quist Zhang Tuesday, February 26, 2013 5:47 AM
    Monday, February 25, 2013 8:42 PM

All replies

  • Retrieve the parent folder of the message from the MailItem.Parent property, then open the parent Store using MAPIFolder.Store, then open the Junk Mail folder of that store using Store.GetDefaultFolder(olFolderJunk).

    Dmitry Streblechenko (MVP)
    http://www.dimastr.com/redemption
    Redemption - what the Outlook
    Object Model should have been
    Version 5.4 is now available!

    • Marked as answer by Quist Zhang Tuesday, February 26, 2013 5:47 AM
    Friday, February 22, 2013 8:34 PM
  • Thanks for the tip Dmitry.  I have tried modifying the code as you suggested, but I must be doing something wrong.  I get the folder from the selected mail item, then try to get the store from the folder, then define the target folder as the junk mail folder for that store.  But Outlook always thinks that the target folder does not exist.  Would you mind taking a look at the code below and let me know where my mistake is?  Thanks for the help!

    Sub JunkToJunk()
    'Based on work of verychewy and Caleb O
    'modified by Gurs
    
    On Error Resume Next
    
        Dim objNS As Outlook.NameSpace
        Dim thisFolder As Outlook.MAPIFolder
        Dim objFolder As Outlook.MAPIFolder
        Dim objItem As Outlook.MailItem
        Dim objStore As Store
    
        Set objNS = Application.GetNamespace("MAPI")
        'Assume this is a mail folder
        Set thisFolder = Application.ActiveExplorer.currentFolder
        Set objStore = thisFolder.MAPIFolder.Store
        Set objFolder = objStore.GetDefaultFolder(olFolderJunk)
        
        'Be sure target folder exists
        If objFolder Is Nothing Then
            MsgBox "This folder doesn’t exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
            Exit Sub
        End If
        
        'Require that this procedure be called only when a message is selected
        If Application.ActiveExplorer.Selection.Count = 0 Then
            Exit Sub
        End If
          
        For Each objItem In Application.ActiveExplorer.Selection
            If objFolder.DefaultItemType = olMailItem Then
                If objItem.Class = olMail Then
                    objItem.UnRead = False
                    objItem.Categories = "Junk"
                    objItem.Move objFolder
                End If
            End If
        Next
        
        Set objNS = Nothing
        Set thisFolder = Nothing
        Set objFolder = Nothing
        Set objItem = Nothing
        Set objStore = Nothing
    
    End Sub

    Monday, February 25, 2013 8:25 PM
  • What do you mean by "Outlook always thinks that the target folder does not exist"? Do you get an error? What is it?

    If the search folder spans multiple stores, you will need to retrieve the parent folder store on the per item basis:

    Set thisFolder =  objItem.Parent
    Set objStore = thisFolder.MAPIFolder.Store
    Set objFolder = objStore.GetDefaultFolder(olFolderJunk)


    Dmitry Streblechenko (MVP)
    http://www.dimastr.com/redemption
    Redemption - what the Outlook
    Object Model should have been
    Version 5.4 is now available!


    Monday, February 25, 2013 8:32 PM
  • Thanks!  After I posted I kept playing with it, and I got it working before I saw your last post.  Final version below.  The definition of thisFolder and objStore look a little different in my version than in your last post, but apparently not enough to derail the macro. 

    Sub JunkToJunk()
    'Based on work of verychewy and Caleb O
    'modified by Gurs
    
    On Error Resume Next
    
        Dim thisFolder As Outlook.MAPIFolder
        Dim objFolder As Outlook.MAPIFolder
        Dim objItem As Outlook.MailItem
        Dim objStore As Store
    
        Set thisFolder = Application.ActiveExplorer.currentFolder
        Set objStore = thisFolder.Store
        Set objFolder = objStore.GetDefaultFolder(olFolderJunk)
        
        'Be sure target folder exists
        If objFolder Is Nothing Then
            MsgBox "This folder doesn’t exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
            Exit Sub
        End If
        
        'Require that this procedure be called only when a message is selected
        If Application.ActiveExplorer.Selection.Count = 0 Then
            Exit Sub
        End If
          
        For Each objItem In Application.ActiveExplorer.Selection
            If objFolder.DefaultItemType = olMailItem Then
                If objItem.Class = olMail Then
                    objItem.UnRead = False
                    objItem.Categories = "Junk"
                    objItem.Move objFolder
                End If
            End If
        Next
        
        Set thisFolder = Nothing
        Set objFolder = Nothing
        Set objItem = Nothing
        Set objStore = Nothing
    
    End Sub

    • Marked as answer by Quist Zhang Tuesday, February 26, 2013 5:47 AM
    Monday, February 25, 2013 8:42 PM