根据 Excel 中的数据集使用 VBA 将 Outlook 文件夹中的电子邮件移动到子文件夹

Question

我在这里发现了一个解决这个问题的问题，类似于我的问题；

如何将具有特定主题的 Outlook 收件箱中的邮件项目移动到特定文件夹/子文件夹？

第一个模块 - 此代码的第一部分 - 我已成功将所有电子邮件数据导出到电子表格。

第二个模块 - 我想指示 Excel VBA 根据我在电子表格中输入的数据集将主文件夹中的电子邮件移动到子文件夹（它不会基于电子邮件本身的过滤器/标准，只是它的独特主题标题）。

在 (c) 列中，是电子邮件的主题（所有主题标题都是特定/唯一的），在 (h) 列中，我详细说明了我也希望将其移动的子文件夹的名称。 不幸的是，我在执行我创建的代码时出错。

我是 Excel VBA 的初学者，并没有最好的理解。我对基于不同来源的代码有所了解，如果不正确，请告诉我，将不胜感激

谢谢你。

• 我尝试执行我在与我类似的用户提出的问题中找到的代码，但它没有用

Sub MovingEmails_Invoices()

  'Declare your Variables
    Dim items As Outlook.items
    Dim subfolder As Outlook.Folder 'this will be the folder you want to move the Mail to

    'Set Outlook Inbox Reference
    Set OP = New Outlook.Application
    Set NS = OP.GetNamespace("MAPI")
    Set Mail = OP.CreateItem(olMailItem)

    'To loop through subfolder and its folders
    Set rootfol = NS.Folders("SYNTHES-JNJCZ-GBS.DE.AT.CH@ITS.JNJ.com")
    Set Folder = rootfol.Folders("Austria")


'The list for invoice number should be dynamic
Dim arraysearch(1 To 1000) As String
Dim i As Long
i = UBound(arraysearch)
arraysearch(i) = Range("C2").offset(i, 0).Value
If i = 0 Then
MsgBox "error"
Exit Sub
End If


'The list for folder type should be dynamic
Dim arraymove(1 To 1000) As String
i = UBound(arraymove)
arraymove(i) = Range("H2").offset(i, 0).Value
If i = 0 Then
MsgBox "error"
Exit Sub
End If

'specific folders for the mail to move to
Set subfolder = rootfol.Folders(arraymove(i))


For Each Mail In Folder.items.Restrict("[Subject] >= arraysearch(i)")

   If arraysearch(i) = arraymove(i) Then

   item.Move subfolder

   End If

   Next Mail

End Sub

Answer 1

在代码中，您要遍历文件夹中的所有项目：

  'Loop through the Items in the folder backwards
     'Setting Mail to counting backwards
    For lngCount = items.Count To 1 Step -1
    'setting object as Email item
        Set item = items.item(lngCount)

这真的不是一个好主意。 特别是如果您以后使用Find方法。

如果您需要查找符合您条件的项目，我建议使用 Items 类的Find / FindNext或Restrict方法。 在以下文章中阅读有关这些方法的更多信息：

• 如何：使用 Find 和 FindNext 方法从文件夹中检索 Outlook 邮件项目（C#、VB.NET）
• 如何：使用限制方法从文件夹中检索 Outlook 邮件项目

此外，您可能会发现Application类的AdvancedSearch方法很有帮助。 在 Outlook 中使用AdvancedSearch方法的主要好处是：

• 搜索在另一个线程中执行。 您不需要手动运行另一个线程，因为AdvancedSearch方法会在后台自动运行它。
• 可以在任何位置搜索任何项目类型：邮件、约会、日历、笔记等，即超出某个文件夹的范围。 Restrict和Find / FindNext方法可以应用于特定的 Items 集合（请参阅 Outlook 中Folder类的Items属性）。
• 完全支持 DASL 查询（自定义属性也可用于搜索）。 您可以在 MSDN 的过滤文章中阅读有关此内容的更多信息。 为了提高搜索性能，如果为商店启用了即时搜索，则可以使用即时搜索关键字（请参阅Store类的IsInstantSearchEnabled属性）。
• 您可以随时使用Search类的Stop方法停止搜索过程。

Answer 2

无需尝试查找该项目。

它已经用Set item = items.item(lngCount)标识。

您可以检查主题，看看它是否是您想要的项目。

'Find Email using Subject found on Column C
'Set item = items.Find(FilterText)

'If the object is an Email
If item.Class = olMail Then

    If item.Subject = FilterText Then 

        'Find item under the main Folder subfolders
        Set subfolder = Folder.Folders(FolderMove)

        'Mark Item as Read
        item.UnRead = False

        'Move Item to folder type in Outlook
        item.Move subfolder
    End If

End If