Solved

How To download attachments from outlook

Posted on 2014-12-07
11
110 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 68

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
 
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
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 68

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

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
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 …
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…

758 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now