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, DanAnonymous
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, DanAnonymous
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