Select all items in a specific folder and move them to another folder

问题

How do I select all Mails in the Deleted Items folder of a shared account (not my personal account) and then move them to a different folder not called "Deleted Items". For now, let's call the destination folder "Old Emails".

Here is what I have written so far:

'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

I am stuck on how to get the macro to select all items in the sourceFolder so it can then move them to the destinationFolder. I prefer not to manually select the emails in the folder before running the macro.

If anyone can provide assistance, that would be appreciated. Thanks!

回答1:

SO is not a code writing service, but here is a code snippet that should help.

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

Let me know in the comments if you have any questions about this.

回答2:

You almost got it, try the following

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

来源：https://stackoverflow.com/questions/38701905/select-all-items-in-a-specific-folder-and-move-them-to-another-folder

标签

vba

outlook

outlook-vba