Question

我正在使用以下功能将所选电子邮件移至另一个文件夹。

错误显示“无法找到某个对象。”

它第一次运行，但任何后续尝试都失败了：

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

当执行以下行时，当我在监视窗口中展开文件夹时，不会显示任何子文件夹：

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

我从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 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

当我重新启动Outlook时，它可以工作。我尝试将几个变量设置为Nothing，执行'End'以希望重置相关变量。重启Outlook时重置了什么？

编辑 - 我已将其缩小到移动线。移动项目后运行sub时会出现问题。

Answer 1

For Each在移动或删除时无法正常工作。

您要么处理第一项，直到没有项目或向后循环。

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

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

＆＃34;要删除文件夹的Items集合中的所有项目，必须删除从文件夹中的最后一项开始的每个项目。例如，在文件夹的项目集合AllItems中，如果文件夹中有n个项目，则开始删除AllItems.Item（n）中的项目，每次递减索引，直到删除AllItems.Item（1）＆＃34;

编辑：2015 06 16

除非有理由使用GetFolder试试这个：

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

Answer 2

非常感谢niton，我将我的子修改为以下内容，其中有效：

<?php include('header.php'); ?>
....
<title> Watches - <?php echo $title; ?> </title>

如果我将电子邮件手动移回原始文件夹并再试一次，问题仍然存在，但我可以忍受！

再次感谢，非常感谢。

Answer 3

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

将所选项目移动到文件夹

3 个答案: