vba 将 Outlook 邮件从一个邮箱收件箱移动到同一邮箱中的不同文件夹
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/1914346/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Move outlook mail from one mailbox inbox to different folder in same mailbox
提问by Steve
I have several mailboxes which I can see in my Outlook profile. One of the mailboxes, let's call it "Mailbox - HUR" receives messages constantly. presently one of my team goes into the inbox of this mailbox every day and moves (drag and drop) the messages into a subfolder of the inbox called Archive (we're an imaginative lot!) if the messages are greater than 24 hours old.
我有几个邮箱，可以在我的 Outlook 配置文件中看到。其中一个邮箱，我们称之为“邮箱 - HUR”，不断接收消息。目前，我的一个团队每天都会进入这个邮箱的收件箱，如果邮件超过 24 小时，就会将邮件移动（拖放）到收件箱的一个名为存档的子文件夹中（我们是一个富有想象力的人！）。
Is there any way that a macro can be set up to do this task? I know my simple way around VBA but have never used it with Outlook and can't figure out the namespace details to point me to the correct mailbox instead of my mailbox.
有什么方法可以设置宏来执行此任务？我知道我绕过 VBA 的简单方法，但从未在 Outlook 中使用过它，并且无法弄清楚命名空间详细信息以将我指向正确的邮箱而不是我的邮箱。
Unfortunately I do not have access to Exchange server, only using outlook client.
不幸的是，我无法访问 Exchange 服务器，只能使用 Outlook 客户端。
Any help anyone could give would be great.
任何人都可以提供的任何帮助都会很棒。
回答by Fionnuala
You might like to try:
您可能想尝试：
Sub MoveOldEmail()
Dim oItem As MailItem
Dim objMoveFolder As MAPIFolder
Dim objInboxFolder As MAPIFolder
Dim i As Integer
Set objMoveFolder = GetFolder("Personal Folders\Inbox\Archive")
Set objInboxFolder = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
For i = objInboxFolder.Items.Count - 1 To 0 Step -1
With objInboxFolder.Items(i)
''Error 438 is returned when .receivedtime is not supported
On Error Resume Next
If .ReceivedTime < DateAdd("h", -24, Now) Then
If Err.Number = 0 Then
.Move objMoveFolder
Else
Err.Clear
End If
End If
End With
Next
Set objMoveFolder = Nothing
Set objInboxFolder = Nothing
End Sub
Public Function GetFolder(strFolderPath As String) As MAPIFolder
'' strFolderPath needs to be something like
'' "Public Folders\All Public Folders\Company\Sales" or
'' "Personal Folders\Inbox\My Folder"
Dim objNS As NameSpace
Dim colFolders As Folders
Dim objFolder As MAPIFolder
Dim arrFolders() As String
Dim i As Long
On Error GoTo TrapError
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
Set objNS = GetNamespace("MAPI")
On Error Resume Next
Set objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For i = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(i))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
On Error GoTo TrapError
Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Exit_Proc:
Exit Function
TrapError:
MsgBox Err.Number & " " & Err.Description
End Function
回答by James
You should setup a mailbox rule. Tools | Rules Wizard
您应该设置邮箱规则。工具 | 规则向导
If you are using Exchange server have an Outlook rule to move the emails to the specific folder, then use the Mailbox Manager in Exchange to delete messages from that folder after a specific period of time. See this articlefor more information.
如果您使用 Exchange 服务器有一个 Outlook 规则将电子邮件移动到特定文件夹，然后使用 Exchange 中的邮箱管理器在特定时间段后从该文件夹中删除邮件。有关更多信息，请参阅此文章。
回答by Robert Trent
Fionnuala you rock!
Fionnuala你摇滚！
I've been looking for a solution to a similar issue for months. With my corporate restrictions, I wasn't able to use the UDF (worked just fine on my personal); Within the sub MoveOldEmail, I instead used:
几个月来，我一直在寻找类似问题的解决方案。由于我的公司限制，我无法使用 UDF（在我个人上工作得很好）；在子 MoveOldEmail 中，我改为使用：
Set objMoveFolder = GetNamespace("MAPI").PickFolder
Cool thing is that this seems to let me move between email accounts that I have associated with my Outlook (until corp figures out at least).
很酷的是，这似乎让我可以在与 Outlook 关联的电子邮件帐户之间移动（至少直到 corp 弄清楚）。
