Avatar of Legolas786
Legolas786
 asked on

How To download attachments from outlook

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

Open in new window

Visual Basic Classic

Avatar of undefined
Last Comment
Nick67

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
Neil Russell

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Qlemo

No answer to the original question (that has been answered by Neilsr already), but you don't write the select that way, repeating all the statements several times. Instead you can use a list of constants to check for, and have a single statement block:
 Select Case Right(olAtt.FileName, 4)
    Case ".xls", ".csv", ".txt", ".mp3", ".jpg", "xlsx", "alnk"
        FileName = frmdownloadattchmts.TextBox1.Value & olAtt.FileName
        olAtt.SaveAsFile FileName
        i = i + 1
 End Select

Open in new window

I've also shortened the check for 4 char extenstions - that should be sufficient.
Nick67

@Qlemo
I've never seen a Case statement written like that!
Is that documented somewhere?

Nick67
Nick67

Ok,
From the Access 2003 Help
Select Case Statement    
Executes one of several groups of statements, depending on the value of an expression.
Syntax

Select Case testexpression
[Case expressionlist-n
[statements-n]] ...
[Case Else
[elsestatements]]

End Select

The Select Case statement syntax has these parts:

Part Description
testexpression Required. Any numeric expression or string expression.
expressionlist-n Required if a Case appears. Delimited list of one or more of the following forms: expression, expression To expression, Is comparisonoperator expression. The To keyword specifies a range of values. If you use the To keyword, the smaller value must appear before To. Use the Is keyword with comparison operators (except Is and Like) to specify a range of values. If not supplied, the Is keyword is automatically inserted.
statements-n Optional. One or more statements executed if testexpression matches any part of expressionlist-n.
elsestatements Optional. One or more statements executed if testexpression doesn't match any of the Case clause.


I just never twigged to it and had never seen or understood that before today!

I always constructed
Select Case True
    case something
    Case something else
    Case else
        Goto Skip
End Select
'code block for true results
skip:
'continuation of code


The comma delimited list is much more elegant!
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
Qlemo

Yes,  indeed.
Legolas786

ASKER
Hi Neilsr,

Many thanks for your help, a quick question once I have downloaded the attachments and the message box appears after download finished, when I click on OK i want to close the userform.  in the bold part below I have tried me.close, unload me and frmdownloadattchmts.close but I am not getting anywhere, could you help me please?thanks a million for all your help.

 
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!"
               [b] Unload Me[/b]
           Else
              MsgBox "I didn't find any attached files in your mail.", vbInformation, _
              "Finished!"
          End If

Open in new window

Nick67

Ah, so you have changed this back from what you had me knock together for you from your original.
You've gone back to the userform.
You didn't post code for the userform, but somewhere in the Click event for it, it calls GetAttachments(SomeInboxSubFolder)

Give it Me.Close afterward and you should be good to go.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Legolas786

ASKER
Qlemo,

I'm sorry as i am new i was not aware that was the procedure, would you like me to accept the answer/close this thread and create a new one?

Nick,

Sorry no your code did help me lots, that was in the module but I have a form where the button is, i have tried what you suggested but it didnt work? the form code is

Option Explicit

Dim NodeX As node, MyArray() As String, i As Long

Private Sub CommandButton1_Click()

    Dim objNode As node
    Dim blnNoNode As Boolean
    
    If Len(TextBox1.Text) = 0 Then
        MsgBox "Fill in File Destination"
        Exit Sub
    End If
    
    blnNoNode = True
    For Each objNode In Me.TreeView1.Nodes
        If objNode = TreeView1.Nodes(1) Then
            ' ignore root node
            
        Else
            If objNode.Checked Then
                GetAttachments objNode.Text
                blnNoNode = False
            End If
        End If
    Next
    
    If blnNoNode Then
        MsgBox "Select a sub folder"
    End If

End Sub




Private Sub TreeView1_NodeClick(ByVal node As MSComctlLib.node)
    Set oSubFldrList = oNameSpace.GetDefaultFolder(olFolderInbox)
    
    If node.Children = 0 Then
        MyArray = Split(node.FullPath, "\")
    
        Set oSubFldrList = oNameSpace.GetDefaultFolder(olFolderInbox)
        For i = 1 To UBound(MyArray)
            Set oSubFldrList = oSubFldrList.Folders(MyArray(i))
        Next
    
        For Each oSubFldritem In oSubFldrList.Folders
            Set NodeX = TreeView1.Nodes.Add(node.Key, tvwChild, oSubFldritem.Name, oSubFldritem.Name)
        Next
        node.Expanded = True
    End If
End Sub


Private Sub UserForm_Initialize()

TextBox1.Text = "C:\Test\"

Set oNameSpace = OutlookApp.GetNamespace("MAPI")
    Set oFldrList = oNameSpace.GetDefaultFolder(olFolderInbox)
    Set NodeX = TreeView1.Nodes.Add(, , "Root", oFldrList.Name)
    Set oSubFldrList = oNameSpace.GetDefaultFolder(olFolderInbox)
    
    If oFldrList.Folders.Count > 0 Then
      For Each objItem In oFldrList.Folders
        Set NodeX = TreeView1.Nodes.Add("Root", tvwChild, objItem.Name, objItem.Name)
      Next objItem
    End If
    Set oSubFldrList = Nothing
End Sub

Open in new window

Nick67

Try this
At the end of Sub GetAttachments (down around line 86) add in
Unload frmdownloadattchmts

...
    GetAttachments_exit:
             Set Atmt = Nothing
             Set Item = Nothing
             Set ns = Nothing
             Unload frmdownloadattchmts
             Exit Sub