Outlook VBA 将发送的会议请求/回复保存到指定文件夹

Question

我在(here)下面找到了代码来让outlook VBA将发送的电子邮件保存到指定的文件夹。

代码运行良好，但是，只要它在发送的会议请求或会议回复上运行，就会出错。

我已经能够将第 9 行识别为发生错误的行：

Set Item.SaveSentMessageFolder = objFolder

然后，我的假设是Item.SaveSentMessageFolder 代码与会议类型对象不兼容。但是，我不确定会议类型对象的等效编码是什么。

是否可以修改此代码以以与处理消息类型对象相同的方式处理会议类型对象？

Private Sub Application_ItemSend(ByVal Item As Object, _
    Cancel As Boolean)
  Dim objNS As NameSpace
  Dim objFolder As MAPIFolder
  Set objNS = Application.GetNamespace("MAPI")
  Set objFolder = objNS.PickFolder
  If TypeName(objFolder) <> "Nothing" And _
     IsInDefaultStore(objFolder) Then
      Set Item.SaveSentMessageFolder = objFolder
  End If
  Set objFolder = Nothing
  Set objNS = Nothing
End Sub

Public Function IsInDefaultStore(objOL As Object) As Boolean
  Dim objApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Dim objInbox As Outlook.MAPIFolder
  On Error Resume Next
  Set objApp = CreateObject("Outlook.Application")
  Set objNS = objApp.GetNamespace("MAPI")
  Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
  Select Case objOL.Class
    Case olFolder
      If objOL.StoreID = objInbox.StoreID Then
        IsInDefaultStore = True
      End If
    Case olAppointment, olContact, olDistributionList, _
         olJournal, olMail, olNote, olPost, olTask
      If objOL.Parent.StoreID = objInbox.StoreID Then
        IsInDefaultStore = True
      End If
    Case Else
      MsgBox "This function isn't designed to work " & _
             "with " & TypeName(objOL) & _
             " items and will return False.", _
             , "IsInDefaultStore"
  End Select
  Set objApp = Nothing
  Set objNS = Nothing
  Set objInbox = Nothing
End Function  

Answer 1

至少有其他人发现该物业无法用于会议项目。

https://msdn.microsoft.com/en-us/vba/outlook-vba/articles/meetingitem-savesentmessagefolder-property-outlook

“设置或获取此属性没有明显效果。请勿使用此属性。”

尝试监控“已发送邮件”文件夹。

将此代码放在 ThisOutlookSession 模块中。

Private WithEvents sentMailItems As items

Private Sub Application_Startup()
    Set sentMailItems = Session.GetDefaultFolder(olFolderSentMail).items
End Sub

Private Sub sentMailItems_ItemAdd(ByVal Item As Object)

    Dim objFolder As Folder

    If TypeOf Item Is MeetingItem Then

        Set objFolder = Session.PickFolder

        If TypeName(objFolder) <> "Nothing" Then
            Item.Move objFolder
        End If

    End If

    Set objFolder = Nothing

End Sub