Question

我的公司使用的是一个云端口系统，当系统在“已删除邮件”文件夹中存放30天时，我们会删除这些邮件（我们使用的是Outlook 2010客户端）。我想要一个脚本，将所有电子邮件从Deleted Items文件夹移动到名为“Trash”的第二个文件夹。我能够在线找到以下大部分脚本，但它对我不起作用，我不确定缺少什么/不正确。任何帮助表示赞赏...

Sub MoveDeletedItems()
Dim oSource As Outlook.MAPIFolder
Dim oTarget As OutlookMAPIFolder
Dim oDummy As Object
Dim oToMove As Object
Dim colItems As Outlook.Items
Dim i As Long

Set oSource = Application.Session.GetDefaultFolder(olFolderDeletedItems)
Set oTarget = oSource.Folders.Folder("Trash")

Set colItems = oSource.Items

For i = colItems.Count To 1 Step -1
Set oToMove = colItems(i)
Set oDummy = oToMove.Move(oTarget)
Next
End Sub

Answer 1

你有很多事情要做，你不需要

以下是一个示例，其中的注释可以作为Outlook中的宏运行。

Sub MoveDeletedItems()
'setup some error checking
On Error GoTo err_rpt
Dim oSource As Outlook.MAPIFolder
Dim oTarget As Outlook.MAPIFolder
Dim oItem

'get the deleted Items folder
Set oSource = Application.Session.GetDefaultFolder(olFolderDeletedItems)
'get the folder under the Deleted Items folder called Trash
Set oTarget = oSource.Folders("Trash")
'loop through all the items in the source folder
For Each oMailItem In oSource.Items 
    'move the item to the target folder
    oItem.Move oTarget
Next

err_rpt:
If Err.Number > 0 Then
    MsgBox Err.Description
End If
'release the folders
Set oTarget = Nothing
Set oSource = Nothing
End Sub

自动将电子邮件从“已删除邮件”文件夹移动到另一个文件

1 个答案: