共用方式為


HOWTO: VB/CDO 1.21 - Delete inbox message attachments over certain size

 

Here is an example:
    'How to read the Inbox messages and delete attachments over a given size using VB and CDO 1.21

    ' This example deletes all jpg file attachments over a certain size in an inbox.
   
    Const CONST_MAX_JPG_ATTACHMENT = 3000   ' TODO: Change this - max jpg file size
    Dim sErrorMessage As String
    Dim objSession As MAPI.Session
    Dim objAttach As MAPI.Attachment
    Dim strExServer As String
    Dim strExUser As String
    Dim objInbox As Folder
    Dim objMessages As Messages
    Dim objMessage As Message
    Dim objAttachments As Attachments
    Dim objAttachment As Attachment
    Dim lAttchmentCount As Long
    Dim lCounter As Long
    Dim lAttchmentSize As Long
   
    Dim sLine As String
    sLine = ""
   
     ' my specific settings
    strExServer = "myemailserver"     ' TODO: Change to the name of email servers or the servers TCP address, or TCP Address + ":" + port number
    strExUser = "mymailbox"           ' TODO: Change to your email mailbox name - the mailbox of the Domain User Account you are going to send from.
 
    'On Error GoTo ErrorCheck
   
    'Create Session and Logon
    Set objSession = New MAPI.Session
    objSession.Logon , , False, True, , True, strExServer & vbLf & strExUser
   
     'Create your Inbox object and get all the messages in the inbox.
     Set objInbox = objSession.Inbox
     Set objMessages = objInbox.Messages

     'Get the first message in the objMessages collection.
     Set objMessage = objMessages.GetFirst

    If objMessage Is Nothing Then
        MsgBox "No messages to process"
    Else
        'Set up a loop to run through all the messages in the inbox.
        Do
            With objMessage
                sLine = "[" & .TimeReceived & "] (" & .Size & " bytes) - " & .Subject & vbCrLf
                sLine = sLine & "           (Message Class: " & .Fields(CdoPR_MESSAGE_CLASS).Value & ")" & vbCrLf
               
                Set objAttachments = objMessage.Attachments
                lAttchmentCount = objAttachments.Count
               
                If lAttchmentCount > 0 Then
                    For lCounter = lAttchmentCount To 1 Step -1  ' Go backward in case you want to delete
                        Set objAttachment = objAttachments.Item(lCounter)
                       
                        sLine = sLine & "    Attachment: " & objAttachment.Name
                        lAttchmentSize = objAttachment.Fields(CdoPR_ATTACH_SIZE)
                        sLine = sLine & " (" & lAttchmentSize & " bytes) " & vbCrLf
                       
                        ' Test to see if the attachment should be deleted - TODO: Change Test as needed
                        If (lAttchmentSize > CONST_MAX_JPG_ATTACHMENT And Right(objAttachment.Name, 4) = ".jpg") Then
                            ' TODO: Uncomment the line below when you are sure you are ready to have attachemnts deleted
                            'objAttachments.Item(lCounter).Delete
                            sLine = "***  Attachment was a big jpg file - Deleted" & vbCrLf
                        End If
                    Next
                    Set objAttachment = Nothing
                   
                End If
                .Update
                Debug.Print sLine
            End With    'objMessage
           
            'Get the next message.
            Set objMessage = objMessages.GetNext
        Loop Until objMessage Is Nothing
    End If
   
    'Logoff your session and destroy your objects.
    objSession.Logoff
    Set objSession = Nothing
    Set objAttach = Nothing
    Set objInbox = Nothing
    Set objMessages = Nothing
    Set objMessage = Nothing
    Set objAttachments = Nothing
    Set objAttachment = Nothing

Comments

  • Anonymous
    May 05, 2009
    please help me to delete a transmitting email that I attached an email containing 86MB.  It has sent in my outbox for four days.  Now other emails will not send and I have to shut down and reboot outlook to get any emails.  I cannot get the email I wanted to send deleted out of the outbox, no matter how I try to delete.  How can I get it out of my outbox for good?

  • Anonymous
    May 18, 2009
    Hello gnaff9093; Can't you delete it out of your outbox manually?  If not, then its best to call-in for Microsoft Support for assistance.  If you cannot delete an item manually in Outlook, then custom code is probably not going to help. Thanks, Dan

  • Anonymous
    May 18, 2009
    Hello gnaff9093; Can't you delete it out of your outbox manually?  If not, then its best to call-in for Microsoft Support for assistance.  If you cannot delete an item manually in Outlook, then custom code is probably not going to help. Thanks, Dan

  • Anonymous
    May 18, 2009
    Hello gnaff9093; Can't you delete it out of your outbox manually?  If not, then its best to call-in for Microsoft Support for assistance.  If you cannot delete an item manually in Outlook, then custom code is probably not going to help. Thanks, Dan