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

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

1 个答案: