Delete based on Attachment Size (Item.Size)...

[adimax]

Alright, I'm pretty happy with my code so far. Its setup as a rule and
when emails with attachments come in, the user is prompted with a save
box, they type a filename in (or Cancel, either way) and everything
works as planned.

However, some of the emails are in error and the attachments of these
emails are always 2k or less. So, now I'm trying to code that part in.
A snippet of my code:


'Process the selected item
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

'Start Process
For Each myItem In myOlSel

'Attachments
Set myAttachments = myItem.Attachments

'Check
If myAttachments.Count > 0 Then

'Do the following
For i = 1 To myAttachments.Count

StartPrompt:

myFin = InputBox("Please type a filename below. You do not have to
include the .wav extension:", "Saving recording...", "")

If myFin = "" Then

myItem.UnRead = True
myItem.Move myDestFolder2

Exit Sub
End If

'Save to destionation folder
myAttachments(i).SaveAsFile myOrt & _
myFin & ".wav"

myItem.UnRead = False
myItem.Move myDestFolder1

Next i

End If

If I were to add the following code :

If myAttachments(i).Item.Size < 2048 Then
myItem.Delete
End If

right before the StartPrompt, would that take care of any 2k or less
files for me before they even get the popup box?

Thanks as always!

 

[adimax]

Answered my own question, it did indeed work! Though I was missing the
ExitSub part after the message was deleted.

So, here is my entire code. If anyone wants to take a look at it and
see if it could be improved, I would greatly appreciate it. I'm
sending it out for beta testing later on tonight and cant wait for
someone to break it this weekend. I know it will happen eventually.



Sub SaveRecordings(MyMail As MailItem)

'Declarations
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt As String
Dim myFin As String
Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim myInbox As Outlook.MAPIFolder
Dim myDestFolder As Outlook.MAPIFolder

Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
' Set myItems = myInbox.Items
Set myDestFolder1 = myInbox.Folders("[Saved Recordings]")
Set myDestFolder2 = myInbox.Folders("[Unsaved Recordings]")

'Destination folder for saved files
myOrt = "W:\"

On Error Resume Next

'Process the selected item
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

'Start Process
For Each myItem In myOlSel

'Attachments
Set myAttachments = myItem.Attachments

'Check
If myAttachments.Count > 0 Then

'Do the following
For i = 1 To myAttachments.Count

If myAttachments(i).Item.Size < 2048 Then

myItem.Delete

Exit Sub
End If

StartPrompt:

myFin = InputBox("Please type a filename below. You do not have to
include the .wav extension:", "Saving recording...", "")

If myFin = "" Then

myItem.UnRead = True
myItem.Move myDestFolder2

Exit Sub
End If

'Save to destionation folder
myAttachments(i).SaveAsFile myOrt & _
myFin & ".wav"

myItem.UnRead = False
myItem.Move myDestFolder1

Next i

End If

Next

'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing

End Sub

 

[adimax]

Grrr-argh! Its not working. Its deleting every email, no matter what
size the attachment (in the case of me discovering this, it was a 599
KB attachment).

I've tried <, <=, >= on the

If myAttachments(i).Item.Size < 2048 Then

code and nothing seems to work. It deletes it every time. What am I
missing?

 

[Ken Slovak - [MVP - Outlook]]

If you look at the Object Browser Help on Attachment.Size you will see that
it says that the size is not always available until the attachment is
extracted. You would have to extract the attachments and save them to the
file system to read the size of the persisted attachment.

If that or getting Size returns an error you can just ignore that
attachment. You can also check to make sure you aren't trying to save out
embedded attachments by testing for Attachment.Type. You will only be able
to save out attachments that are OLAttachmentType.olByValue.