当项目按收件箱规则移动时,Item_Add代码不执行



我有一些日常报告(Excel文件(通过电子邮件发送给我。收件箱规则将电子邮件移动到名为"的Outlook文件夹中;每日报告";。

当电子邮件按规则移动到文件夹中时,我希望附件自动保存到文件夹中并按日期组织。类似于:C:\Desktop\ReportName\2019\11-2019\11-05-2019 Report Name.xlsx

我有几个问题。

  1. 当规则移动电子邮件时,代码不会运行,只有当我手动移动电子邮件时才会运行
  2. 它创建新的目录并保存第一封电子邮件的附件,但其他电子邮件会提供路径/访问错误参考
MkDir ("C:UsersusernameDesktopOutlook Test Folder" & Format(Date, "YYYY"))
Private WithEvents olItems As Outlook.Items
Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
Set olItems = objNS.GetDefaultFolder(olFolderInbox).Parent.Folders("Daily Reports").Items
Set objNS = Nothing
End Sub
Private Sub olItems_ItemAdd(ByVal Item As Object)
Dim NewMail As Outlook.MailItem
Dim Atts As Attachments
Dim strPath As String
Dim attName As String

If Item.Class = olMail Then
Set NewMail = Item
End If

If Dir("C:UsersusernameDesktopOutlook Test Folder" & Format(Date, "YYYY"), vbDirectory) = "" Then
MkDir ("C:UsersusernameDesktopOutlook Test Folder" & Format(Date, "YYYY"))
End If
If Dir("C:UsersusernameDesktopOutlook Test Folder" & Format(Date, "YYYY" & "" & Format(Date, "MM-YYYY")), vbDirectory) = "" Then
MkDir ("C:UsersusernameDesktopOutlook Test Folder" & Format(Date, "YYYY") & "" & Format(Date, "MM-YYYY"))
End If

If InStr(LCase(Item.Subject), "daily applications was executed at") > 0 Then
strPath = "C:UsersusernameDesktopOutlook Test Folder" & Format(Date, "YYYY") & "" & Format(Date, "MM-YYYY")
attName = " Daily Applications.Xlsx"
ElseIf InStr(LCase(Item.Subject), "dailyopenedcalls was executed at") > 0 Then
strPath = "C:UsersusernameDesktopOutlook Test Folder" & Format(Date, "YYYY") & "" & Format(Date, "MM-YYYY")
attName = " Daily Opened Calls.Xlsx"
End If
Set Atts = Item.Attachments
If Atts.Count > 0 Then
For Each Att In Atts
If InStr(LCase(Att.FileName), ".xlsx") > 0 Then
Att.SaveAsFile strPath & "" & Format(Date, "mm-dd-yyyy") & attName
End If
Next
End If
End Sub
  1. 只有当我手动移动电子邮件时,规则移动电子邮件时代码才运行

如果将多个项目移动到一个文件夹中,则可能不会触发ItemAdd事件。这是Outlook中的一个已知问题。

另一个可能的原因是Outlook规则在Application_Startup之前运行。

  1. 它可以很好地创建新目录并保存第一个电子邮件附件,但其他电子邮件会出现路径/访问错误

确保使用路径或文件中允许的符号。我建议尝试手动创建相同的路径,以使路径中只使用允许的符号。

最新更新