Consulting

Results 1 to 3 of 3

Thread: Moving Messages

  1. #1

    Moving Messages

    Now I know there are probably a few posts about this floating around however I am having an extremely difficult time finding one that will work. I have sent the last hour looking on the internet for a solution to my problem and have gotten nothing that wants to work.

    So here it is I just want to move a darn email using a macro.

    Now I know there are other ways to do this however my boss has very specifically requested i patch together a macro for him (and since i like my job I am not about to be arguing about it) that does two things makes the selected email or emails marked as read and then archives them. We as a firm move emails as soon as we have read them and dealt with them or alternatively the moment they come in if they do not have to be read first, so volume wise this action will never be performed on more then 1 to 3 emails at a time.

    The marking as read part I have working with no problem on one email but i am not sure how to take it from that to the nth email.
    Right now I am using this to mark as read:

    Set obj = Application.ActiveExplorer.Selection(1)obj.UnRead = False
    obj.Save
    Set obj = Nothing

    Now after that point I would like to call another macro to move all the selected emails to the Archive Folder (the default one where emails go when you hit backspace or press the Archive button).

    And that is it.


    As a bit of a informational point here I am using Outlook 2016.

    Any help would be greatly appreciated.

  2. #2
    The default archive folder is a folder called Archive off the root folder (but it can be a user configured folder) . Assuming you have the default setup, the following should work.

    Option Explicit 
     
    Sub ArchiveSelected() 
         'Graham Mayor - http://www.gmayor.com - Last updated - 12 Oct 2017
        Dim olItem As Object 
        Dim olFolder As Outlook.Folder 
        Dim lngItem As Long 
        If Application.ActiveExplorer.Selection.Count = 0 Then 
            MsgBox "No Items selected!", vbCritical, "Error" 
            Exit Sub 
        End If 
        On Error Resume Next 
        Set olFolder = Session.GetDefaultFolder(olFolderInbox).Parent.folders("Archive") 
         'Process each selected message
        For lngItem = Application.ActiveExplorer.Selection.Count To 1 Step -1 
            Set olItem = Application.ActiveExplorer.Selection(lngItem) 
            olItem.UnRead = False 
            olItem.Move olFolder 
        Next lngItem 
    lbl_Exit: 
        Set olItem = Nothing 
        Set olFolder = Nothing 
        Exit Sub 
    End Sub 
    
    
    Formatting tags added by mark007
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Thank You!!!!!! I can't say I exactly see where I was going wrong in this but right right now that doesn't matter so much. I was ready to start beating my head against a wall in frustration yesterday so this is greatly appreciated and it works perfectly.

Posting Permissions

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