Question

用户有一些VBA代码弹出文件夹视图，以选择保存＆＃34;已发送项目＆＃34;的副本的位置。当＆＃34;发送＆＃34;被按下了。

问题是，它只适用于主邮箱，而不适用于PST＆＃39>

有没有办法让这段代码也能复制到PST文件夹？

Private Sub Application_ItemSend(ByVal Item As Object, _
                                 Cancel As Boolean)
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
    On Error Resume Next
    Set objNS = Application.Session
    If Item.Class = olMail Then
        Set objFolder = objNS.PickFolder
        If Not objFolder Is Nothing And _
          IsInDefaultStore(objFolder) And _
          objFolder.DefaultItemType = olMailItem Then
            Set Item.SaveSentMessageFolder = objFolder

            Set msg = MailItem.Copy
            msg.UnRead = False

            msg.Save

            msg.Move objNS.GetDefaultFolder(olFolderSentMail)
        Else
            Set objFolder = _
              objNS.GetDefaultFolder(olFolderSentMail)
            Set Item.SaveSentMessageFolder = objFolder

            Set msg = MailItem.Copy
            msg.UnRead = False

            msg.Save

            msg.Move objNS.GetDefaultFolder(olFolderSentMail)
        End If
    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
    Dim blnBadObject As Boolean
    On Error Resume Next
    Set objApp = objOL.Application
    If Err = 0 Then
        Set objNS = objApp.Session
        Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
        Select Case objOL.Class
            Case olFolder
                If objOL.StoreID = objInbox.StoreID Then
                    IsInDefaultStore = True
                Else
                    IsInDefaultStore = False
                End If
            Case olAppointment, olContact, olDistributionList, _
                 olJournal, olMail, olNote, olPost, olTask
                If objOL.Parent.StoreID = objInbox.StoreID Then
                    IsInDefaultStore = True
                Else
                    IsInDefaultStore = False
                End If
            Case Else
                blnBadObject = True
        End Select
    Else
        blnBadObject = True
    End If
    If blnBadObject Then
        MsgBox "This function isn't designed to work " & _
                "with " & TypeName(objOL) & _
                " objects and will return False.", _
                , "IsInDefaultStore"
        IsInDefaultStore = False
    End If
    Set objApp = Nothing
    Set objNS = Nothing
    Set objInbox = Nothing
End Function

Answer 1

您的意思是您希望将邮件移至默认的“已发送邮件”文件夹以外的其他位置吗？如果是这样，您需要让用户选择它或通过NameSpace.GetFolderFromID获取Folder对象，如果您已在某处保存目标文件夹的Folder.EntryID值。否则，您必须通过在NameSpace.Stores中为每个商店循环遍历Store.Folders来按名称查找文件夹，这可能会变得令人讨厌。

Outlook VBA - 使用PickFolder复制到PST

1 个答案: