Question

我无法在Outlook 2013中新收到的电子邮件上运行宏。

下面的宏（仅根据我发现实现类似目标的代码进行编辑）旨在将附件重命名为电子邮件的主题，然后将其保存到桌面上的给定文件夹中。

我设置了以下规则，在给定某些参数的电子邮件上运行此脚本。该规则将始终将匹配的电子邮件移动到它应该的文件夹，但是，它并不总是将宏应用于它。

我发现它只会在之前收到的电子邮件中应用宏，并且只有在该文件夹的电子邮件列表中选择了该邮件时才会应用该宏。

例如，如果文件夹为空并且我收到符合条件的电子邮件（我们将其称为“＃34;电子邮件A＆＃34;”），则会将其移至正确的文件夹并标记为已读且无宏运行。

但是，如果我选择＆＃34;发送电子邮件A＆＃34;所以它显示在阅读窗格中并且另一个匹配的电子邮件进来（＆＃34;电子邮件B＆＃34;），它将在＆＃34;电子邮件A＆＃34;上运行宏。只有而不是＆＃34;电子邮件B。＆＃34;

我对此很陌生，但似乎我只是在忽视某些事情。任何和所有的帮助将不胜感激。

规则：

邮件到达后应用此规则
  来自＆＃39; emailaddress@email.com'
    并且有附件
    并且在这台电脑上只有   把它移到＆＃39; XYZ＆＃39;文件夹
    并运行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

Answer 1

有关从规则运行宏的信息，请参阅此处： http://qlockwork.com/timetrackingthoughts/2012/10/microsoft-outlook-2010-tips-how-to-run-a-vba-macro-on-new-emails/

从快速浏览一下，您的问题似乎是您忽略了传递给您的程序的项目：

Sub SaveAttachments(itm As Outlook.MailItem)

itm是新的邮件项目，但在您的宏中，您正在使用收件箱中的所选项目：您应该直接使用{{ 1}}

你也不需要这个：

itm

因为已经有一个Set objOL = CreateObject("Outlook.Application")对象可用于在Outlook中运行的任何VBA代码

Outlook 2013 VBA宏未在新邮件上运行

1 个答案: