Solved

How To download attachments from outlook

Posted on 2014-12-07
11
116 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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 70

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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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 70

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

Title # Comments Views Activity
Using an encrypted  value to decrypt and display contents in vb6 9 63
VBA - If Bookmark = "XXBOOKMARKXX" then 15 62
Assign a value in Excel V-Basic 3 36
VB6 Enviroment 3 33
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
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…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

737 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