Moving an email from Inbox to a sub-folder

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 = "M_H@metricuu.com\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
    Next
   
    Set objItem = Nothing
    Set MoveToFolder = Nothing
    Set ns = Nothing

End Sub
MoeMoe7Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
HI,

pls try

with this function

Set MoveToFolder = GetFolderPath("M_H@metricuu.com\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
    Next
End If

Set GetFolderPath = oFldr
End Function

Open in new window

Regards
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
MoeMoe7Author Commented:
RGonzo,

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("M_H@metricuu.com\Inbox\Client\00_E44xx\E4422").Items

and added your function.

Unfort, it did not work.
0
Rgonzo1971Commented:
Hi,

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

Regards
0
MoeMoe7Author Commented:
RGonzo,

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 = "M_H@metricuu.com\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
    Next
  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!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.