Solved: How to check for file type when using VBA to auto extract attachment from email

[sgcareerman]

I am a noob in VBA programming, can only understand basic function and usage also some simple coding modification

I use the following VBA coding in outlook 2010 to auto extract all attachment from emails that i receive but i face a issue that it also extracts images in the emails as attachment too.

How can I modify the coding to not save attachment if it does not match certain files types?
I also need the coding not to save attachment if the file size is more than 3 MB.

Experts and pro kindly help.


Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "c:\temp"
For Each objAtt In itm.Attachments
stFileName = saveFolder & "\" & objAtt.DisplayName
i = 0
JumpHere:
If Dir(stFileName) = "" Then
objAtt.SaveAsFile stFileName
Else
i = i + 1
stFileName = saveFolder & "\" & i & " - " & objAtt.DisplayName
GoTo JumpHere
End If
Set objAtt = Nothing
Next

itm.Delete

End Sub

[BrianMH]

Just add an if statement. For instance if you want to only download excel files then the below should work.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "c:\temp"
For Each objAtt In itm.Attachments
stFileName = saveFolder & "\" & objAtt.DisplayName
i = 0
JumpHere:
If Dir(stFileName) = "" Then
if ucase(objAtt.DisplayName) like "*.XLS" then
objAtt.SaveAsFile stFileName
end if
Else
i = i + 1
stFileName = saveFolder & "\" & i & " - " & objAtt.DisplayName
Goto JumpHere
End If
Set objAtt = Nothing
Next

itm.Delete

End Sub

As for attachment size I got this from google. Don't have time to implement it into this code but it should get you started.

http://www.add-in-express.com/creating-addins-blog/2009/10/23/outlook-attachment-size/

[sgcareerman]

BrianMH thanks for the reply

I was wonder if the code below will work and how to modify it to check for a few file type.

If file extension is not doc or xls or txt,rtf then it will not safe the file.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "c:\temp"
For Each objAtt In itm.Attachments
If Right(objAtt.FileName, 3) <> "doc" Then
Set objAtt = Nothing
Next
End If
stFileName = saveFolder & "\" & objAtt.DisplayName
i = 0
JumpHere:
If Dir(stFileName) = "" Then
objAtt.SaveAsFile stFileName
Else
i = i + 1
stFileName = saveFolder & "\" & i & " - " & objAtt.DisplayName
GoTo JumpHere
End If
Set objAtt = Nothing
Next

itm.Delete

End Sub

[BrianMH]

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "c:\temp"
For Each objAtt In itm.Attachments
stFileName = saveFolder & "\" & objAtt.DisplayName
i = 0
JumpHere:
If Dir(stFileName) = "" Then
Select Case UCase(Right(objAtt.DisplayName, 3))
Case "XLS", "DOC", "TXT", "RTF"
objAtt.SaveAsFile stFileName
End Select
Else
i = i + 1
stFileName = saveFolder & "\" & i & " - " & objAtt.DisplayName
GoTo JumpHere
End If
Set objAtt = Nothing
Next

itm.Delete

End Sub


In this instance the select case function works better. This doesn't take into account files like .docx, .xlsb, .xlsx etc. Also are you sure you want to delete an email even if you didn't download anything from it?