Outlook2003中的已发邮件归类？？？

schbippp

各位大哥：
使用Outlook2003时间久了，已发件箱就有很多邮件，找起来久很麻烦，能否：先在发件箱起好文件夹名，然后发送邮件时自动弹出一个对话框，选择保存已发邮件的文件夹？谢谢！

roof

这是在网上找来的：http://www.outlookcode.com/article.aspx?id=48 ，如果你用的是outlook2007可以试一下。发邮件时outlook会要求选择一个文件夹，保存正在发送的邮件。

如果用的是2007之前的版本，应该可以在新邮件的“选项”对话框中选择储存文件夹。

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
        Else
            Set objFolder = _
              objNS.GetDefaultFolder(olFolderSentMail)
            Set Item.SaveSentMessageFolder = objFolder
        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

[ 本帖最后由 roof 于 2009-3-13 13:46 编辑 ]

schbippp

感谢兄弟；
刚才在OUTLOOK2003建立了宏，试了一下，没反应；
难道每次都要“在新邮件的“选项”对话框中选择储存文件夹”？

roof

没有反应可以设置断点，然后单步执行看看哪里出错。另外确认安全级别设置不是“高”。

schbippp

感谢，已OK！

fujitsuql

不错，好贴子，学习了