Solved

How To download attachments from outlook

Posted on 2014-12-07
11
113 Views
Last Modified: 2014-12-10
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

0
Comment
Question by:Legolas786
  • 4
  • 2
  • 2
  • +1
11 Comments
 
LVL 37

Accepted Solution

by:
Neil Russell earned 500 total points
ID: 40485414
You can use the .UnRead porperty of an outlook Item as added to your code below. See line 34

  ' 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
			// check for unread item
			If olItem.UnRead = True Then
               ' 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
			End if
        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


//EDIT
Hmmm formatting went to pot!
0
 
LVL 69

Expert Comment

by:Qlemo
ID: 40485908
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.
0
 
LVL 26

Expert Comment

by:Nick67
ID: 40487229
@Qlemo
I've never seen a Case statement written like that!
Is that documented somewhere?

Nick67
0
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
LVL 26

Expert Comment

by:Nick67
ID: 40487234
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!
0
 
LVL 69

Expert Comment

by:Qlemo
ID: 40487241
Yes,  indeed.
0
 

Author Comment

by:Legolas786
ID: 40487789
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

0
 
LVL 26

Expert Comment

by:Nick67
ID: 40487966
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.
0
 

Author Comment

by:Legolas786
ID: 40488365
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

0
 
LVL 26

Expert Comment

by:Nick67
ID: 40489154
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
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

790 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question