Ron,
Thank you. Your solution is elegant and it worked perfectly. I was able to
find another bit of code that allowed me to recusively walk the list of
folders. When I encountered the folder of interest, I passed it to your
code. Below are the code listings.
Thanks, regards,
Gary
Attribute VB_Name = "Module1"
Option Explicit
Public folder_name As String
'
'This macro was acquired from the Outlook Community -- invoked using a button
'
Public Sub Process_All_Folders()
Dim Outlook_folder As MAPIFolder
For Each Outlook_folder In GetNamespace("MAPI").Folders
If Outlook_folder.DefaultItemType = olMailItem Then
Call Process_Folder(Outlook_folder)
End If
Next Outlook_folder
End Sub
'
'This macro was acquired from the Outlook Community -- called by
Process_All_Folders()
'
Public Sub Process_Folder(ByRef Outlook_folder As MAPIFolder)
Dim sub_folder As MAPIFolder
For Each sub_folder In Outlook_folder.Folders
Call Process_Folder(sub_folder)
If sub_folder.DefaultItemType = olMailItem Then
folder_name = sub_folder.Name
If folder_name = "Organization_LAT" Then
MsgBox "Found: " & folder_name
'Arg 1 = Folder name in your Inbox
'Arg 2 = File extension, "" is every file
'Arg 3 = Save folder, "C:\Users\Ron\test" or ""
'If you use "" it will create a date/time stamped
'folder for you in the "My Documents" folder.
'Note: If you use this "C:\Users\Ron\test" the folder must exist
Call SaveEmailAttachmentsToFolder(sub_folder, "xls", "")
End If
End If
Next sub_folder
End Sub
'
'This macro was acquired from the Excel Community -- courtesy of Ron de
Bruin (
http://www.rondebruin.nl/tips.htm).
'Check Ron's site for the original version of the macro -- his original
version worked perfectly.
'I modified the original version to suit a special purpose in my environment
-- to pass the sub_folder to be processed.
'
'This macro is called by Process_Folder()
'
Sub SaveEmailAttachmentsToFolder(ByRef sub_folder As MAPIFolder, ExtString
As String, DestFolder As String)
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim MyDocPath As String
Dim I As Integer
Dim wsh As Object
Dim fs As Object
On Error GoTo ThisMacro_err
' Check subfolder for messages and exit of none found
If sub_folder.Items.Count = 0 Then
MsgBox "There are no messages in this folder : " & sub_folder,
vbInformation, "Nothing Found"
Set Item = Nothing
Set wsh = Nothing
Set fs = Nothing
Exit Sub
End If
'Create DestFolder if DestFolder = ""
If DestFolder = "" Then
Set wsh = CreateObject("WScript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")
MyDocPath = ActiveWorkbook.Path
DestFolder = MyDocPath & "\MDCL_files_to_process"
If Not fs.FolderExists(DestFolder) Then
fs.CreateFolder DestFolder
End If
End If
If Right(DestFolder, 1) <> "\" Then
DestFolder = DestFolder & "\"
End If
' Check each message for attachments and extensions
I = 0
For Each Item In sub_folder.Items
For Each Atmt In Item.Attachments
If LCase(Right(Atmt.FileName, Len(ExtString))) =
LCase(ExtString) Then
FileName = DestFolder & Item.SenderName & " " & Atmt.FileName
Atmt.SaveAsFile FileName
I = I + 1
End If
Next Atmt
Next Item
' Show this message when Finished
If I > 0 Then
MsgBox "You can find the files here : " _
& DestFolder, vbInformation, "Finished!"
Else
MsgBox "No attached files in your mail.", vbInformation, "Finished!"
End If
' Clear memory
ThisMacro_exit:
Set Item = Nothing
Set wsh = Nothing
Set fs = Nothing
Exit Sub
' Error information
ThisMacro_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: SaveEmailAttachmentsToFolder" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume ThisMacro_exit
End Sub
Ron de Bruin said:
Hi Gary
Maybe you can use this
http://www.rondebruin.nl/mail/folder2/saveatt.htm
--
Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
Gary said:
Summary:
My main goal is to extract and process all of the excel files that are
attached to email messages within an outlook.pst file, that I created using
the EXPORT facility within Outlook.
Detail:
1) I have 100's of email messages very similar in form and content to the
following message:
From: (e-mail address removed)
To: (e-mail address removed)
Cc: no_one
Subject: LAT System Monitor
Attachments: lat_system_monitor.xls (675 KB)
[This is the very short body of the message.]
2) I EXPORTed the Outlook folder that contains these messages to an Outlook
.PST file – using Microsoft Word 2002 (XP).
Questions/Comments:
1) I would like to write Excel macros (I am reasonably
comfortable/proficient) to extract and process the EXCEL attachments to each
message.
2) Is there a documented format for reading the outlook.pst file and
locating the Excel attachment? I have searched the web and the excel/outlook
communities and cannot find any references.
3) Is there a better/other way?
Thanks, Regards,
Gary
