Question

如何选择共享帐户（不是我的个人帐户）的“已删除邮件”文件夹中的所有邮件，然后将其移至另一个未调用的文件夹＆＃34;已删除邮件＆＃34;。现在，让我们调用目标文件夹＆＃34; Old Emails＆＃34;。

这是我到目前为止所写的内容：

'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

这不是代码编写服务，但这里有一个应该有用的代码片段。

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

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

Answer 2

你几乎得到了它，试试以下

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

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

2 个答案: