Search for attached files in Outlook 2007

Another good link
http://office.microsoft.com/en-us/outlook/HA012305851033.aspx 

A VBA sub to do this ... can adapt as necessary is as follows:

Chris

Sub Email2Excel()
' Requires excel object library to be added to the outlook VBA references
Dim olapp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim MyFolder As Outlook.MAPIFolder
Dim mai As mailitem
Dim xlApp As Excel.Application
Dim xlwb As Excel.Workbook
Dim xlws As Excel.Worksheet
Dim xlpath As String
Dim xlbook As String
Dim xlsheet As String
Dim maiInspector As Outlook.Inspector
Dim xlIsOpen As Boolean
Dim att As Integer
Dim rw As Long
 
    #If CBPC = True Then
        xlpath = "C:\Users\Chris\Experts Exchange"
        xlbook = "JPG Mails.xls"
        xlsheet = "Sheet1"
    #Else
        xlpath = "C:\"
        xlbook = "JPG MAils.xls"
        xlsheet = "Sheet1"
    #End If
    
    On Error Resume Next
    Set olapp = Outlook.Application
    Set objNS = olapp.GetNamespace("MAPI")
    Set MyFolder = objNS.PickFolder
                   
    Set xlApp = GetObject(, "Excel.Application")
    xlIsOpen = (Not xlApp Is Nothing)
    If xlApp Is Nothing Then Set xlApp = CreateObject("Excel.application")
    ' fileExists modifies trims path and ensures a trailing slash
    If FileExists1(xlpath, xlbook) Then
        On Error Resume Next
        Set xlwb = xlApp.Workbooks(xlbook)
        On Error GoTo 0
        If xlwb Is Nothing Then Set xlwb = xlApp.Workbooks.Open(xlpath & xlbook)
        If xlws Is Nothing Then Set xlws = xlwb.Worksheets(xlsheet)
    Else
         Set xlwb = xlApp.Workbooks.Add
         xlwb.SaveAs FileName:=(xlpath & xlbook)
         If xlws Is Nothing Then Set xlws = xlwb.Worksheets(xlsheet)
    End If
    xlws.Cells.Clear
    xlws.Range("A1") = "JPG Mail Received Time"
    xlws.Range("B1") = "JPG Mail Subject"
    xlws.Range("C1") = "JPG Mail Attachment Details"
    For Each mai In MyFolder.Items
        If mai.Class = olMail Then
           On Error GoTo assumeEncrypted
               On Error GoTo inspectMai
               If mai.Attachments.Count >= 1 Then
                For att = 1 To mai.Attachments.Count
                    If mai.Attachments.Item(att).FileName Like "*.doc" Then
                       rw = xlws.Range("A" & xlws.Rows.Count).End(xlUp).Offset(1, 0).Row
                       xlws.Range("A" & rw) = mai.ReceivedTime
                       xlws.Range("B" & rw) = mai.Subject
                       xlws.Range("C" & rw) = "Attachment Number " & att & " is JPG Entitled: " & mai.Attachments.Item(att).FileName
'                       Set maiInspector = mai.GetInspector
'                       maiInspector.Activate
'                        Stop
'                        If Not maiInspector Is Nothing Then maiInspector.Close (olDiscard)
                    End If
                Next
            End If
            xlws.Range("A:C").Columns.AutoFit
           On Error GoTo assumeEncrypted
        End If
        GoTo assumeEncrypted
inspectMai:
    Set maiInspector = mai.GetInspector
    maiInspector.Activate
    Stop
    If Not maiInspector Is Nothing Then maiInspector.Close (olDiscard)
    Err.Clear
assumeEncrypted:
    Next
    GoTo exiat
 
    
exiat:
    If Not xlApp Is Nothing Then
        xlApp.DisplayAlerts = False
        If Not xlwb Is Nothing Then xlwb.Save
        If Not xlwb Is Nothing And Not xlIsOpen Then xlwb.Close
        xlApp.DisplayAlerts = True
        Set xlApp = Nothing
    End If
Set objNS = Nothing
Set olapp = Nothing
Set MyFolder = Nothing
 
End Sub

Select allOpen in new window

Note if you do not want a hard copy there are other approaces one if which is rem'd out in teh above code.

You can rem out the write to excel and all code associated if you want and uncomment:

'                       Set maiInspector = mai.GetInspector
'                       maiInspector.Activate
'                        Stop
'                        If Not maiInspector Is Nothing Then maiInspector.Close (olDiscard)

this will open up a window containing the email with each JPG attachment

The important note is therefore to say most things are possible so if the approach works for you but needs tweaking then say so and we can see what can reasonably be done.

Chris