如何在新邮件到达时为MS Outlook中的共享邮箱触发vba宏

我在outlook中创建了一个新的“规则”，用于在收到新邮件时搜索邮件主题中的特定单词。如果它找到了特定的单词，它就会调用下面的脚本。该脚本是作为默认项目1下的新模块创建的

脚本会将附件从电子邮件中剥离出来，并将其放在本地计算机上。它非常适合我的个人收件箱，但我很难让它适合团体收件箱

我认为组收件箱名称称为“邮箱-！XXXXXXXXXXXXXXXXXXXXX”。我通过右键单击共享收件箱并查看“位置：字段”下的“常规”选项卡来检索此信息

我想我需要在代码中的某个地方添加组收件箱名称，然后引用其中的邮件项目，因为我猜它正在我的个人收件箱中查找邮件项目。只是不太确定如何添加它）任何帮助都将不胜感激

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "d:\temp\"
     For Each objAtt In itm.Attachments
          objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
          Set objAtt = Nothing
     Next
End Sub

---

如果使用规则，则更改收件箱太迟

将共享邮箱添加到您的配置文件中，然后尝试ItemAdd

示例代码位于ThisOutlookSession模块中

Option Explicit

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
  Dim objNS As NameSpace
  Set objNS = Application.Session
  ' instantiate objects declared WithEvents
  Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
  Set objNS = Nothing
End Sub

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
  On Error Resume Next
  Itm.BodyFormat = olFormatPlain
  Itm.Save
  Set Itm = Nothing
End Sub

你可以用这样的东西指向共享收件箱

Set olInboxItems = _
  objNS.Folders("Mailbox - ! XXXX XXXXX XXXXXXX XXXXX").Folders("Inbox").Items

---

应用程序_NewMail对此不起作用？谢谢，您可以尝试回答我的问题。[链接]出现权限错误，显示“无法保存附件-没有权限保存附件”。有什么想法吗？编辑问题。将当前代码添加到原始问题中。