选择特定文件夹中的所有项目并将它们移动到另一个文件夹

Question

如何选择共享帐户（不是我的个人帐户）的“已删除邮件”文件夹中的所有邮件，然后将它们移动到不称为“已删除邮件”的其他文件夹中。现在，让我们将目标文件夹称为“旧电子邮件”。

这是我目前所写的：

'Macro for pseudo-archiving
Sub PseudoArchive()
On Error Resume Next

Dim objNamespace As Outlook.NameSpace
Dim sourceFolder As Outlook.MAPIFolder
Dim Messages As Selection
Dim Msg As MailItem

Set objNamespace = GetNamespace("MAPI")
Set sourceFolder = objNamespace.Folders("sharedemail@website.com")
Set sourceFolder = objFolder.Folders("Deleted Items")

'Define path to the target folder
Set destinationFolder = ns.Folders("sharedemail@website.com").Folders("Old Emails")

'Move emails in sourceFolder to destinationFolder
For Each Msg In sourceFolder
    Msg.Move destinationFolder
Next

Set objNamespace = Nothing
Set sourceFolder = Nothing
Set Messages = Nothing
Set Msg = Nothing

End Sub

我被困在如何让宏选择sourceFolder 中的所有项目，然后它可以将它们移动到destinationFolder。我不想在运行宏之前手动选择文件夹中的电子邮件。

如果有人可以提供帮助，将不胜感激。谢谢！

Answer 1

你差不多了，试试下面的

Option Explicit
Sub PseudoArchive()
    Dim objNamespace As Outlook.NameSpace
    Dim sourceFolder As Outlook.MAPIFolder
    Dim destinationFolder As Outlook.MAPIFolder
    Dim Items As Outlook.Items
    Dim Item As Object
    Dim Msg As String
    Dim i As Long

    Set objNamespace = GetNamespace("MAPI")
    Set sourceFolder = objNamespace.Folders("sharedemail@website.com").Folders("Deleted Items")
    Set destinationFolder = objNamespace.Folders("sharedemail@website.com").Folders("Inbox").Folders("Old Emails")
    Set Items = sourceFolder.Items

    'Move emails in sourceFolder to destinationFolder
    Msg = Items.Count & " Items in " & sourceFolder.Name & ", Move?"

    If MsgBox(Msg, vbYesNo) = vbYes Then
        For i = Items.Count To 1 Step -1
            Set Item = Items.Item(i)
            DoEvents
            Item.Move destinationFolder
        Next
    End If

End Sub

Answer 2

SO 不是代码编写服务，但这里有一个代码 sn-p 应该会有所帮助。

Dim olApp As Outlook.Application
Dim olFol As Outlook.Folder, olDestFol As Outlook.Folder
Dim olItem As Object
Dim i as Long, j as Long
Set olApp = New Outlook.Application olApp.GetNamespace("MAPI").Folders("mailboxnamehere").Folders("Deleted Items")
Set olDestFol = olApp.GetNamespace("MAPI").Folders("mailboxnamehere").Folders("Inbox").Folders("Deleted Items") ' Destination Folder
Do Until olFol.Items.Count = 0
    olFol.Items(1).Move olDestFolder
Loop

如果您对此有任何疑问，请在 cmets 中告诉我。