0
votes

I am using the below function to move selected emails to another folder.

The error says "An object could not be found."

It works the first time, but any subsequent attempts fail on the line:

Set TestFolder = SubFolders.Item(FoldersArray(i))

When the following line executes, when I expand folders in the watch window, no subfolders appear:

Set TestFolder = Application.Session.Folders.Item(FoldersArray(0))

I am calling the function from a sub:

Option Explicit

Private Item As Object, olkItem As Object
Private AutoReply As String
Private myDestFolder As Outlook.Folder, myInbox As Outlook.Folder
Private myNameSpace As Outlook.NameSpace

Sub ReplywithNote2()

Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myDestFolder = GetFolder("\\PO_Queries\Inbox\Completed")

For Each olkItem In Application.ActiveExplorer.Selection
    With olkItem
        If .Class = olMail Then
            '.Move myDestFolder
        End If
    End With
Next

End Sub

Function:

Function GetFolder(ByVal FolderPath As String) As Outlook.Folder

Set GetFolder = Nothing

Dim TestFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer

'On Error GoTo GetFolder_Error

If Left(FolderPath, 2) = "\\" Then
    FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If

'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")

Set TestFolder = Application.Session.Folders.Item(FoldersArray(0))

If Not TestFolder Is Nothing Then
    For i = 1 To UBound(FoldersArray, 1)

        Dim SubFolders As Outlook.Folders
        Set SubFolders = TestFolder.Folders
        Set TestFolder = SubFolders.Item(FoldersArray(i))

        If TestFolder Is Nothing Then
            Set GetFolder = Nothing
        End If
    Next
End If

'Return the TestFolder
Set GetFolder = TestFolder
On Error GoTo 0
Exit Function

GetFolder_Error:
Set GetFolder = Nothing
Exit Function

End Function

When I restart Outlook it works. I tried setting several variables to Nothing, executing 'End' in the hope of resetting the relevant variable. What is reset when I restart Outlook?

Edit - I've narrowed it down to the move line. The problem occurs when running the sub after having moved the item.

3
Works fine, with my test Sub. Include just enough of your code to allow others to reproduce the problem. stackoverflow.com/help/mcveniton

3 Answers

1
votes

For Each does not work correctly when moving or deleting.

You either process item one until there are no items left or loop backwards.

For i = Application.ActiveExplorer.Selection.Count to 1 step -1

https://msdn.microsoft.com/en-us/library/office/ff863343%28v=office.15%29.aspx

"To delete all items in the Items collection of a folder, you must delete each item starting with the last item in the folder. For example, in the items collection of a folder, AllItems, if there are n number of items in the folder, start deleting the item at AllItems.Item(n), decrementing the index each time until you delete AllItems.Item(1)."

Edit: 2015 06 16

Unless there is a reason for using GetFolder try this:

Set myDestFolder = myNameSpace.Folders("PO_Queries").Folders("Inbox").Folders("Completed")
0
votes

Many thanks to niton, I amended my sub to the following, which works:

Sub ReplywithNote2()

    Set myNameSpace = Application.GetNamespace("MAPI")
    Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
    Set myDestFolder = GetFolder("\\PO_Queries\Inbox\Completed")

    For i = Application.ActiveExplorer.Selection.Count To 1 Step -1
        With Application.ActiveExplorer.Selection.Item(i)
            If .Class = olMail Then
                .Move myDestFolder
            End If
        End With
    Next

End Sub

The issue still occurs if I move the email back into the original folder manually and try again, but I can live with that!

Thanks again, most grateful.

0
votes
Sub myMove()

Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myDestFolder = GetFolder("\\xxx\folder1\folder2\folder3")
Dim i As Long
For Each olkItem In Application.ActiveExplorer.Selection
 i = MsgBox("Do you want to move selected emails to folder folder3?", vbYesNo + vbQuestion + vbSystemModal + vbMsgBoxSetForeground, "Confirm Move")
    If i = vbNo Then
        Cancel = True
        End
      Else
        'Continue moving message
           For i = Application.ActiveExplorer.Selection.Count To 1 Step -1
                With Application.ActiveExplorer.Selection.Item(i)
                    If .Class = olMail Then
                        .Move myDestFolder
                    End If
                End With
           Next
End
    End If

Next

End:
End Sub