如何在 Outlook 2016 中取消 .PickFolder 对话框时指定当前邮箱已发送邮件文件夹？

Question

我有一个 VBA 脚本，用于在发送电子邮件时提示选择文件夹。当您在文件夹列表对话框中单击“取消”时，Outlook 崩溃。

我想，如果我单击“取消”，电子邮件副本将保存到“已发送邮件”文件夹。如何为当前邮箱指定文件夹名称？

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
    ElseIf TypeName(objFolder) = "Nothing" Then
        'Attempt to specify folder for cancelled
        Set Item.SaveSentMessageFolder = "Sent Items"
    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

VBA 不会“短路”And 评估 - 它评估测试的两个部分，然后比较结果

If TypeName(objFolder) <> "Nothing" And IsInDefaultStore(objFolder) Then

即使 TypeName(objFolder) <> "Nothing" 为 False，它仍然会测试 IsInDefaultStore(objFolder)，因此您需要将它们放入两个单独的测试中。

  Set objFolder = objNS.PickFolder
  If TypeName(objFolder) <> "Nothing" Then
      If IsInDefaultStore(objFolder) Then 
          Set Item.SaveSentMessageFolder = objFolder
      End If
  Else
      Set Item.SaveSentMessageFolder = "Sent Items"
  End If

请注意，在 VBA 中使用 If obj Is Nothing 比测试 If TypeName(obj) = "Nothing" 更典型