Macro for extracting and saving Attachment

[Jason]

I have a macro to extract Excel files from Inbox items and it seems to work because the files are in their destination, but I get a runtime error each time on the highlighted line. It says "Outlook cannot do this action on this type of attachement"

I can't figure out what I've left off...


Sub GetEmailAttachments()

Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
i = 0

If Inbox.Items.Count = 0 Then
MsgBox "There are no messages in the Inbox.", vbInformation, _
"Nothing Found"
Exit Sub
End If

For Each Item In Inbox.Items
For Each Atmt In Item.Attachments
If Right(Atmt.FileName, 3) = "xls" Then
FileName = "P:\databases\downloads\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
Next Atmt
Next Item

If i > 0 Then
MsgBox "I found " & i & " attached files." _
& vbCrLf & "I have saved them into the C:\Email Attachments folder." _
& vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
Else
MsgBox "I didn't find any attached files in your mail.", vbInformation, _
"Finished!"
End If

GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub


End Sub

 

[Roady [MVP]]

And the highlighted line would be...?

Note that the developers live down the hall in outlook.program_vba

 

[Jason]

Sorry...I highlighted it when I posted but looks like that didn't take. The highlighted line is:

If Right(Atmt.FileName, 3) = "xls" Then

 

[Roady [MVP]]

At first glance you are very minimalistic in declaring your variables. I'm
not sure if that is eventually causing you the issues but you could check
with the developers down the hall in outlook.program_vba