Moving an email from Inbox to a sub-folder

Posted on 2014-09-01
Last Modified: 2014-09-02
I am trying to move a selected email item to a specific folder under the Inbox, but it fails on me because it fails to correctly assign the path to the desired location.

The code is below.  Using the Watch window, I can see that MoveToFolder is nothing.  What am I missing?

Dim ns As Outlook.NameSpace
    Dim MoveToFolder As Outlook.MAPIFolder
    Dim objItem As Outlook.MailItem
    Dim MoveToHere As String
    Set ns = Application.GetNamespace("MAPI")

    MoveToHere = "\Inbox\Client\00_E44xx\E4422"
    'Set MoveToFolder = F.Folders
    Set MoveToFolder = ns.Folders.Item(MoveToHere)
    If Application.ActiveExplorer.Selection.Count = 0 Then
        MsgBox ("No item selected")
        Exit Sub
    End If
    If MoveToFolder Is Nothing Then
        MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
    End If
    For Each objItem In Application.ActiveExplorer.Selection
        If MoveToFolder.DefaultItemType = olMailItem Then
            If objItem.Class = olMail Then
                objItem.Move MoveToFolder
            End If
            End If
    Set objItem = Nothing
    Set MoveToFolder = Nothing
    Set ns = Nothing

End Sub
Question by:MoeMoe7
    LVL 47

    Accepted Solution


    pls try

    with this function

    Set MoveToFolder = GetFolderPath("\Inbox\Client\00_E44xx\E4422").Items 
    Function GetFolderPath(ByVal FldrPath As String) As Outlook.Folder
    Dim oFldr As Outlook.Folder
    Dim arrFldr As Variant
    Dim Idx As Integer
    arrFldr = Split(FldrPath, "\")
    Set oFldr = Application.Session.Folders.Item(arrFldr(0))
    If Not oFldr Is Nothing Then
        For Idx = 1 To UBound(arrFldr, 1)
            Dim SubFldrs As Outlook.Folders
            Set SubFldrs = oFldr.Folders
            Set oFldr = SubFldrs.Item(arrFldr(i))
            If oFldr Is Nothing Then
                Set GetFolderPath = Nothing
            End If
    End If
    Set GetFolderPath = oFldr
    End Function

    Open in new window


    Author Comment


    I put that function in there and I ran the code.  I can see that the function was called, but the MoveToFolder remained empty.

    I replaced my line
    Set MoveToFolder = ns.Folders.Item(MoveToHere)
    with yours
    Set MoveToFolder = GetFolderPath("\Inbox\Client\00_E44xx\E4422").Items

    and added your function.

    Unfort, it did not work.
    LVL 47

    Expert Comment


    Could you put a break point at line 24 of my code and run the code (F9)

    then see in Locals the value of IDx and of oFldr


    Author Comment


    Thank you for you help.  I could not get your code to work, but it pointed me to here...

    This is what finally worked.

    Set MoveToFolder = GetFolder(DaFolder2)
    'where DaFolder = "\Inbox\Client\00_E44xx\E4422"
    Public Function GetFolder(strFolderPath As String) As MAPIFolder
      ' strFolderPath needs to be something like
      '   "Public Folders\All Public Folders\Company\Sales" or
      '   "Personal Folders\Inbox\My Folder"
      Dim objApp As Outlook.Application
      Dim objNS As Outlook.NameSpace
      Dim colFolders As Outlook.Folders
      Dim objFolder As Outlook.MAPIFolder
      Dim arrFolders() As String
      Dim I As Long
      On Error Resume Next
      strFolderPath = Replace(strFolderPath, "/", "\")
      arrFolders() = Split(strFolderPath, "\")
      Set objApp = Application
      Set objNS = objApp.GetNamespace("MAPI")
      Set objFolder = objNS.Folders.Item(arrFolders(0))
      If Not objFolder Is Nothing Then
        For I = 1 To UBound(arrFolders)
          Set colFolders = objFolder.Folders
          Set objFolder = Nothing
          Set objFolder = colFolders.Item(arrFolders(I))
          If objFolder Is Nothing Then
            Exit For
          End If
      End If
      Set GetFolder = objFolder
      Set colFolders = Nothing
      Set objNS = Nothing
      Set objApp = Nothing
    End Function

    Open in new window

    To be honest, I don't understand the differences.  But without your input, I would not have found it!

    Thank you!

    Featured Post

    Live: Real-Time Solutions, Start Here

    Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

    Join & Write a Comment

    This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
    If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
    The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
    Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

    754 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    17 Experts available now in Live!

    Get 1:1 Help Now