Vba 如何创建脚本以将收件箱中当前活动的电子邮件移动到Outlook 2007中的其他文件夹
我有时会收到我想保留的电子邮件,但将它们移动到适当的文件夹可能会很痛苦。例如,我如何执行一个脚本,将我正在查看的电子邮件移动到一个名为“buffer”的特定文件夹中(如使用C-S-v) 我正在使用Outlook 2007 谢谢Vba 如何创建脚本以将收件箱中当前活动的电子邮件移动到Outlook 2007中的其他文件夹,vba,outlook,outlook-2007,Vba,Outlook,Outlook 2007,我有时会收到我想保留的电子邮件,但将它们移动到适当的文件夹可能会很痛苦。例如,我如何执行一个脚本,将我正在查看的电子邮件移动到一个名为“buffer”的特定文件夹中(如使用C-S-v) 我正在使用Outlook 2007 谢谢 编辑: 没有任何标准可以像通过规则一样自动创建此过程。这仅仅是我盯着它看时做出的判断。工具->规则和警报 然后创建一个新规则,告诉所有符合任何条件的邮件被删除/标记为已读/移动到文件夹/这些条件的任意组合 编辑: 如果您不需要规则/无法创建适合的规则,可以创建宏(工具-
编辑:
没有任何标准可以像通过规则一样自动创建此过程。这仅仅是我盯着它看时做出的判断。工具->规则和警报 然后创建一个新规则,告诉所有符合任何条件的邮件被删除/标记为已读/移动到文件夹/这些条件的任意组合 编辑:
如果您不需要规则/无法创建适合的规则,可以创建宏(工具->宏)将其移动到文件夹,然后将其绑定到快捷方式。以下是我使用的代码
Sub MoveSelectedMessagesToFolder()
'Originally written by Chewy Chong
'Taken from http://verychewy.com/archive/2006/04/12/outlook-macro-to-move-an-email-to-folder.aspx
'Thanks Chewy!
'Ken
On Error Resume Next
Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
'For the "Item" portion, I used the name of the folder exactly as it appear in the ToolTip when I hover over it.
Set objFolder = objNS.Folders.Item("Personal Folders").Folders.Item("Buffer")
'Assume this is a mail folder
If objFolder Is Nothing Then
MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
End If
If Application.ActiveExplorer.Selection.Count = 0 Then
'Require that this procedure be called only when a message is selected
Exit Sub
End If
For Each objItem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move objFolder
End If
End If
Next
此代码可能工作得更好 在代码中,objFolder可能等于零,但您仍要继续此过程。此外,For-Each循环假定每个项目都是邮件项目
Sub MoveSelectedMessagesToFolder()
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim obj As Object
Dim msg As Outlook.mailItem
Set objNS = Application.GetNamespace("MAPI")
On Error Resume Next
Set objFolder = objNS.Folders.item("Personal Folders").Folders.item("Buffer")
On Error GoTo 0
If objFolder Is Nothing Then
MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
Exit Sub
End If
For Each obj In ActiveExplorer.Selection
If TypeName(obj) = "MailItem" Then
Set msg = obj
msg.Move objFolder
End If
Next obj
End Sub
花了几秒钟才意识到我需要将“个人文件夹”改为“邮箱-尼尔·巴恩韦尔”,但我最终还是做到了。可能会在顶部更新一些变量?