MailItem moved to wrong folder

Question

I was trying to implement a script to move a specific mail to a new folder - no tough stuff. It is scripted in Outlook 2013 and implemented as a rule on incoming mails. The code:

Public Sub MoveToFolder(Item As Outlook.MailItem) 
  '' ... variable definitions ... 
  Set oloUtlook = CreateObject("Outlook.Application")
  Set ns = oloUtlook.GetNamespace("MAPI")
  Set itm = ns.GetDefaultFolder(olFolderInbox)
  Set foldd = ns.Folders.GetFirst.Folders

  For x = 1 To foldd.Count
    If foldd.Item(x).Name = "Inbox" Then
        Set fold = foldd.Item(x).Folders
        For i = 1 To fold.Count
            If fold.Item(i).Name = "Reports" Then
                If fold.Item(i).Folders.GetFirst.Name <> Format(Date, "yyyy-mm") Then
                    fold.Item(i).Folders.Add (Format(Date, "yyyy-mm"))
                End If
                Set newfold = fold.Item(i).Folders.GetFirst
                MsgBox newfold.Name
                Item.Copy (newFold)
                ''Item.Move (newfold)
            End If
        Next i
    End If
  Next x
End Sub

The message comes to folder Inbox, I'd like to move it to: Reports -> 2013-XX depending on the current month.

MessageBox shows the correct folder name. but the message is copied to folder "Inbox" as a duplicate.

What am I doing wrong? Cheers.

Answer 1

I'm not sure why your method isn't working. When I run it in 2010, it gets the right folder. I'm not sure why you think the current date folder will always be the first folder, but I've never used GetFirst, so maybe I just don't understand it. Here's a more straightforward way to test and create a folder and it may work for you.

Public Sub MoveToFldr(Item As MailItem)

    Dim oFldr As Folder
    Dim fReports As Folder

    Set fReports = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Reports")

    On Error Resume Next
        Set oFldr = fReports.Folders(Format(Date, "yyyy-mm"))
    On Error GoTo 0

    If oFldr Is Nothing Then
        Set oFldr = fReports.Folders.Add(Format(Date, "yyyy-mm"))
    End If

    Item.Move oFldr

End Sub