【发布时间】：2015-04-25 07:17:45
【问题描述】：
我无法让宏在 Outlook 2013 中新收到的电子邮件上运行。
下面的宏（只是根据我发现的代码进行编辑以实现类似目标）旨在将附件重命名为电子邮件的主题，然后将其保存到桌面上的给定文件夹中。
我设置了以下规则，以便在给定特定参数的电子邮件上运行此脚本。该规则将始终将匹配的电子邮件移动到它应该的文件夹，但是，它并不总是将宏应用到它。
我发现它只会将宏应用于以前收到的电子邮件，并且只有在该文件夹中的电子邮件列表中选择了该邮件时。
例如，如果文件夹为空并且我收到一封符合条件的电子邮件（我们将其称为“电子邮件 A”），它只会被移动到正确的文件夹并标记为已读，并且不会运行宏。
但是，如果我选择“电子邮件 A”以便它显示在阅读窗格中并且另一封匹配的电子邮件进入（“电子邮件 B”），它将仅在“电子邮件 A”而不是“电子邮件 B”上运行宏。 "
我对此很陌生，但似乎我只是忽略了一些东西。任何和所有的帮助将不胜感激。
规则：
在消息到达后应用此规则
来自'emailaddress@email.com'
并且有附件
并且仅在这台计算机上
将其移至“XYZ”文件夹
并运行 Project1.ThisOutlookSession.SaveAttachments
并将其标记为已读
代码：
Sub SaveAttachments(itm As Outlook.MailItem)
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strFileName As String
Dim objSubject As String
Dim strDeletedFiles As String
' Get the path to your My Documents folder
' strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
On Error Resume Next
' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection
' The attachment folder needs to exist
' You can change this to another folder name of your choice
' Set the Attachment folder.
strFolderpath = "Z:\Desktop\GAreports\"
' Check each selected item for attachments.
For Each objMsg In objSelection
'Set FileName to Subject
objSubject = objMsg.Subject
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
If lngCount > 0 Then
' Use a count down loop for removing items
' from a collection. Otherwise, the loop counter gets
' confused and only every other item is removed.
For i = lngCount To 1 Step -1
' Get the file name.
strFileName = objSubject & ".csv"
' Combine with the path to the Temp folder.
strFile = strFolderpath & strFileName
Debug.Print strFile
' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile
Next i
End If
Next
ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub
【问题讨论】：