RDO 会话 - 遍历整个收件箱并移动电子邮件答案

【问题标题】：RDO Session - loop through entire Inbox and move emailsRDO 会话 - 遍历整个收件箱并移动电子邮件
【发布时间】：2020-06-25 17:09:28
【问题描述】：

感谢本网站提供的出色帮助，我找到了以下代码 - 运行良好。我无法（非常尴尬）弄清楚如何遍历整个收件箱以移动所有电子邮件（而不是像下面的代码那样选择）。

非常感谢任何帮助。
约翰

Sub MoveWithRecDate()
' Moves selected emails with correct dates maintained

Dim objNS As Outlook.NameSpace
Dim Session As Redemption.RDOSession
Dim objRDOFolder As Redemption.RDOFolder
Dim objItem As Outlook.MailItem
Dim objRDOMail As Redemption.RDOMail

Set objNS = Application.GetNamespace("MAPI")
Set Session = CreateObject("Redemption.RDOSession")
Session.Logon
Set inbox = Session.GetDefaultFolder(olFolderInbox)
Set objRDOFolder = inbox.Parent.Folders("Cabinet")

For Each objItem In Application.ActiveExplorer.Selection
     Set objRDOMail = Session.GetMessageFromID(objItem.EntryID)
     objRDOMail.Move objRDOFolder
Next

End Sub

【问题讨论】：

标签： vba outlook

【解决方案1】：

在阅读您的问题之前，我没有听说过救赎。它看起来很有趣，所以谢谢你提供的信息；下次需要编写新的 Outlook 宏时我会尝试。

由于您的问题没有得到答案，我假设也很少有人使用 Redemption。

兑换网站暗示兑换代码的结构将与标准 Outlook 代码几乎相同。我只记得有一次编写了一个对用户选择的项目进行操作的宏，但我记得代码看起来像你的。下面的代码是标准的 Outlook，但我希望这足以让您创建等效的兑换代码。

您的宏有注释' Moves selected emails with correct dates maintained。这意味着您认为有一种方法可以移动电子邮件，从而不维护日期。我不知道这样的方法。

下面的代码检查收件箱中的每个项目。我不想将所有内容从收件箱中移出，因此我跳过了不是邮件项目且不是来自特定发件人的项目。

我希望这足以让你继续前进。

Sub MoveWithRecDate()

  Dim FolderDest As MAPIFolder
  Dim ItemToBeMoved As Boolean
  Dim ItemCrnt As Object
  Dim FolderSrc As MAPIFolder

  Set FolderSrc = CreateObject("Outlook.Application"). _
              GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
  Set FolderDest = FolderSrc.Parent.Folders("Cabinet")

  For Each ItemCrnt In FolderSrc.Items
    ItemToBeMoved = True   ' Assume item to be moved until discover otherwise
    With ItemCrnt
      If .Class = olMail Then
        If .SenderEmailAddress <> "noreply@which.co.uk" Then
          ' Mail item not from Which
          ItemToBeMoved = False
        End If
      Else
        ' Not mail item so do not move
        ItemToBeMoved = False
      End If
      If ItemToBeMoved Then
        .Move FolderDest
      End If
    End With
  Next

End Sub

【讨论】：