troubleshooting Question

How To download attachments from outlook

Avatar of Legolas786
Legolas786 asked on
Visual Basic Classic
9 Comments1 Solution184 ViewsLast Modified:
Hi,

In Excel I use the following coding to download attachments from a sub folder in my inbox, it works fine but is it possible to ONLY download attachemnts from emails that are unread?

I would appreciate any advise or help that you can give me.



 
  ' public objects moved from Userform code module
    Public OutlookApp As New Outlook.Application
    Public oNameSpace    As Namespace
    Public oFldrList     As Outlook.MAPIFolder
    Public objItem       As Outlook.MAPIFolder
    Public oSubFldrList  As Outlook.MAPIFolder
    Public oSubFldritem  As Outlook.MAPIFolder
    
    
    Sub GetAttachments(Name As String)
           On Error GoTo GetAttachments_err
           Dim MyMail As MailItem
           Dim ns As Namespace
           Dim Inbox As MAPIFolder
           Dim SubFolder As MAPIFolder
           Dim Item As Object
           Dim Atmt As Attachment
           Dim FileName As String
           Dim i As Integer
           Dim olItem As MailItem
           Dim olAtt As Outlook.Attachment
          
        i = 0
            If oFldrList.Folders.Count = 0 Then
                MsgBox oFldrList.Name & " has no sub folders"
                MsgBox "There are " & oFldrList.Items.Count & " items in folder"
            Else
                Set SubFolder = oFldrList.Folders(Name)
               ' MsgBox SubFolder.Name & " has " & SubFolder.Items.Count & "  items folders"
            End If
    
            For Each olItem In SubFolder.Items
               ' MsgBox olItem.Subject & vbLf & "has " & olItem.Attachments.Count & " attachements"
                For Each olAtt In olItem.Attachments
    Select Case Right(olAtt.FileName, 4)
    Case ".xls"
        FileName = frmdownloadattchmts.TextBox1.Value & olAtt.FileName
          olAtt.SaveAsFile FileName
        i = i + 1
    Case ".csv"
        FileName = frmdownloadattchmts.TextBox1.Value & olAtt.FileName
          olAtt.SaveAsFile FileName
        i = i + 1
    Case ".txt"
        FileName = frmdownloadattchmts.TextBox1.Value & olAtt.FileName
          olAtt.SaveAsFile FileName
        i = i + 1
    Case ".mp3"
           FileName = frmdownloadattchmts.TextBox1.Value & olAtt.FileName
          olAtt.SaveAsFile FileName
        i = i + 1
    Case ".jpg"
           FileName = frmdownloadattchmts.TextBox1.Value & olAtt.FileName
          olAtt.SaveAsFile FileName
        i = i + 1
    Case Else
        Select Case Right(olAtt.FileName, 5)
        Case ".xlsx"
            FileName = frmdownloadattchmts.TextBox1.Value & olAtt.FileName
          olAtt.SaveAsFile FileName
        i = i + 1
    Case ".alnk"
            FileName = frmdownloadattchmts.TextBox1.Value & olAtt.FileName
          olAtt.SaveAsFile FileName
        i = i + 1
        End Select
    End Select
                Next
            Next
        
        If i > 0 Then
              MsgBox "I found " & i & " attached files." _
                 & vbCrLf & "I have saved them on the" & frmdownloadattchmts.TextBox1.Value & " Path." _
                 & vbCrLf & vbCrLf & " ", vbInformation, "Download Finished!"
                Unload Me
           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
    GetAttachments_err:
             MsgBox "An unexpected error has occurred." _
                & vbCrLf & "Please note and report the following information." _
                & vbCrLf & "Macro Name: GetAttachments" _
                & vbCrLf & "Error Number: " & Err.Number _
                & vbCrLf & "Error Description: " & Err.Description _
                , vbCritical, "Error!"
             Resume GetAttachments_exit
    
    
    End Sub
ASKER CERTIFIED SOLUTION
Neil Russell
Solution Development Specialist

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Join our community to see this answer!
Unlock 1 Answer and 9 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 9 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros