?
Solved

Save outlook attachments from an Outlook folder to a file folder with the same name

Posted on 2010-09-02
3
Medium Priority
?
339 Views
Last Modified: 2012-06-27
I need a function, which saves the attachments in the emails inside an outlook folder to a file folder on the drive with the same name. So lets say the outlook folder is named Cortina. The code looks through the folders to find if there are any files with attachments.  The following code achieves that.

So when the code realizes there is a new file with an attachment inside the folder, it will take that file and save it under c:\roberto\cortina

SO if the outlook folder was named roddick than the path would have been c:\roberto\roddick.

how can I achieve this?
Sub GoToProjectsFolder()
'Makes the "Projects" folder the active folder in the current instance of Outlook
'v1.00 28Jun2007
    Dim myolApp As Outlook.Application
    Dim mynamespace As Outlook.NameSpace
    Dim myFolder As Outlook.MAPIFolder
    Dim found As Boolean
    Dim strFolderName As String
Dim oltempitem As Object
Dim atmt As Attachment
Dim filename As String
Dim filefolder As String

    'specify the folder you are looking for
    strFolderName = "Inbox"
    
   
    Set myolApp = GetObject(, "Outlook.Application")
    Set mynamespace = myolApp.GetNamespace("MAPI")
    
    
    Set myFolder = mynamespace.Folders("Mailbox - Ruben Cortina").Folders("Clients")
    
   For i = 1 To myFolder.Folders.Count
For j = 1 To myFolder.Folders(i).Items.Count


'myFolder.Folders.Ite

'   MsgBox myFolder.Folders(i)
'myFolder.Folders (i)
   Set oltempitem = myFolder.Folders(i).Items(j)
    If myFolder.Folders(i).Items(j).Attachments.Count > 0 Then

For Each atmt In myFolder.Folders(i).Items(j).Attachments
'
'MsgBox myFolder.Folders(i).Items(j).EntryID
'
'myFolder.Folders(i).Items(j).EntryID
    
   


Next
'MsgBox oltempitem.Subject
End If

   
   Next
    
Next
    
'   For i = 1 To (mynamespace.Folders.Count)
   

    Set myolApp = Nothing
    Set mynamespace = Nothing
    
    
    
End Sub

Open in new window

0
Comment
Question by:awesomejohn19
[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
  • 2
3 Comments
 
LVL 38

Expert Comment

by:puppydogbuddy
ID: 33596289
Have a look at the sample code at this link:
           http://www.slovaktech.com/code_samples.htm#StripAttachments

The code has a called function to add the attachments to a temp folder, which you should be able to adapt to your needs.
0
 
LVL 31

Accepted Solution

by:
Helen Feddema earned 2000 total points
ID: 33596317
This code will do it (modify as needed for your setup):
Public Sub StoreAttsInFolder()
'Created by Helen Feddema 2-Sep-2010
'Last modified by Helen Feddema 2-Sep-2010

On Error GoTo ErrorHandler

   Dim nms As Outlook.NameSpace
   Dim ofld As Outlook.Folder
   Dim sfld As Scripting.Folder
   Dim fil As Scripting.File
   Dim fldInbox As Outlook.Folder
   Dim itm As Object
   Dim msg As Outlook.MailItem
   Dim att As Outlook.Attachment
   Dim strAttName As String
   Dim strFolderName As String
   Dim strRootFolder As String
   Dim fso As New Scripting.FileSystemObject
   Dim strFolderPath As String
   Dim strFilePath As String
   
   strRootFolder = "G:\Documents\Attachments\"
   Set nms = Application.GetNamespace("MAPI")
   Set fldInbox = nms.GetDefaultFolder(olFolderInbox)
   
   For Each ofld In fldInbox.Folders
      strFolderName = ofld.Name
      For Each itm In ofld.Items
         If itm.Class = olMail Then
            Set msg = itm
            If msg.Attachments.Count > 0 Then
               For Each att In msg.Attachments
                  'Create Explorer folder if needed
                  strAttName = att.FileName
                  strFolderPath = strRootFolder & strFolderName
                  Debug.Print "Folder path: " & strFolderPath
                  Set sfld = fso.GetFolder(strFolderPath)
                  strFilePath = strFolderPath & "\" & strAttName
                  Debug.Print "File path: "; strFilePath
                  att.SaveAsFile strFilePath
               Next att
            End If
         End If
      Next itm
   Next ofld
   
ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   If Err.Number = 76 Then
      Set sfld = fso.CreateFolder(strFolderPath)
      Resume Next
   Else
      MsgBox "Error No: " & Err.Number _
         & " in StoreAttsInFolder procedure; " _
         & "Description: " & Err.Description
      Resume ErrorHandlerExit
   End If
   
End Sub

Open in new window

0
 
LVL 31

Expert Comment

by:Helen Feddema
ID: 33596319
Also, declare the ofld variable as MAPIFolder if using a version of Outlook earlier than 2007
0

Featured Post

Get your Conversational Ransomware Defense e‑book

This e-book gives you an insight into the ransomware threat and reviews the fundamentals of top-notch ransomware preparedness and recovery. To help you protect yourself and your organization. The initial infection may be inevitable, so the best protection is to be fully prepared.

Question has a verified solution.

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

Changing a few Outlook Options can help keep you organized!
If you troubleshoot Outlook for clients, you may want to know a bit more about the OST file before doing your next job. IMAP can cause a lot of drama if removed in the accounts without backing up.
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

718 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