We help IT Professionals succeed at work.

Looking for specific attachments in Outlook

kjanicke
kjanicke asked
on
Medium Priority
206 Views
Last Modified: 2010-04-08
In reference to this question ...

http://www.experts-exchange.com/Applications/MS_Office/Outlook/Q_22047080.html

Is it possible to make this go thru all the sub folders too?
Comment
Watch Question

CERTIFIED EXPERT
Top Expert 2010

Commented:
Sure.  I'll make that change and get it posted as quick as I can (next 3-4 hours).
CERTIFIED EXPERT
Top Expert 2010
Commented:
Try this, Karyl.  I recommend putting this in a module by itself.

'Change the file name and path as needed.
Const strFilename = "C:\eeTesting\Attachment Search Results.htm"
Dim objFSO As Object, _
    objFile As Object, _
    colExtensions As New Collection, _
    objIE As Object

Sub FindSpecificAttachmentType()
    Dim varExtensions As Variant, _
        arrExtensions As Variant, _
        varExtension As Variant
    varExtensions = InputBox("Enter one or more extensions to search for." & vbCrLf _
        & "Separate multiple extensions with spaces." & vbCrLf _
        & "Example: jpg tif tiff", "Attachment Type Search")
    arrExtensions = Split(varExtensions, " ")
    If IsArray(arrExtensions) Then
        For Each varExtension In arrExtensions
            colExtensions.Add LCase(varExtension), LCase(varExtension)
        Next
    Else
        colExtensions.Add LCase(varExtensions)
    End If
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile(strFilename)
    SearchFolder Application.ActiveExplorer.CurrentFolder
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    Set colExtensions = Nothing
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Navigate2 "file://" & strFilename
    Do While objIE.readyState <> 4
        DoEvents
    Loop
    objIE.Visible = True
    Set objIE = Nothing
End Sub

Sub SearchFolder(olkFolder As Outlook.MAPIFolder)
    Dim olkSubFolder As Outlook.MAPIFolder, _
        olkItem As Object, _
        olkAttachment As Outlook.Attachment
    For Each olkItem In olkFolder.Items
        If olkItem.Attachments.Count > 0 Then
            On Error Resume Next
            For Each olkAttachment In olkItem.Attachments
                varExtension = objFSO.GetExtensionName(LCase(olkAttachment.FileName))
                varItem = colExtensions.Item(varExtension)
                If Err.Number = 0 Then
                    strPath = olkItem.Parent.Path
                    objFile.WriteLine "<a href=""Outlook:" & olkItem.EntryID & """>" & olkItem.Subject & "</a><br>"
                    Exit For
                End If
            Next
            On Error GoTo 0
        End If
    Next
    For Each olkSubFolder In olkFolder.Folders
        SearchFolder olkSubFolder
    Next
    Set olkAttachment = Nothing
    Set olkItem = Nothing
    Set olkSubFolder = Nothing
End Sub

Not the solution you were looking for? Getting a personalized solution is easy.

Ask the Experts

Author

Commented:
Have I told you before how much I love your code bits?

In the middle of a server crash so I'll have to try it later.

With my luck ... the next question i post will be "How do I recover testing all these code bits?"

THANKS!!!  You are awesome.
CERTIFIED EXPERT
Top Expert 2010

Commented:
You're far too kind, but thanks!  Hope the server crash doesn't turn ugly.

Author

Commented:
It works!!!  Thank you!!!

Of course the other sysadmin had to try it at the root level of the mailbox or on their PST's right away and it errored.

But if they want other functionaility ... well ... we both need to learn to code.

You are awesome.  Thanks.  
CERTIFIED EXPERT
Top Expert 2010

Commented:
Hmmm, it shouldn't matter what level it's started at or what folder it starts in.  I'll run some test and see what's going on.
CERTIFIED EXPERT
Top Expert 2010

Commented:
Ok, I found a problem.  An error occurs when the code hits a Notes folder since notes don't support attachments.  I've adjusted the code to ignore everything but messages.  Replace the FindSpecificAttachmentType subroutine you have now with the one below.

Sub FindSpecificAttachmentType()
    Dim varExtensions As Variant, _
        arrExtensions As Variant, _
        varExtension As Variant
    varExtensions = InputBox("Enter one or more extensions to search for." & vbCrLf _
        & "Separate multiple extensions with spaces." & vbCrLf _
        & "Example: jpg tif tiff", "Attachment Type Search")
    arrExtensions = Split(varExtensions, " ")
    If IsArray(arrExtensions) Then
        For Each varExtension In arrExtensions
            colExtensions.Add LCase(varExtension), LCase(varExtension)
        Next
    Else
        colExtensions.Add LCase(varExtensions)
    End If
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile(strFilename)
    SearchFolder Application.ActiveExplorer.CurrentFolder
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    Set colExtensions = Nothing
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Navigate2 "file://" & strFilename
    Do While objIE.readyState <> 4
        DoEvents
    Loop
    objIE.Visible = True
    Set objIE = Nothing
End Sub

Author

Commented:
People usually get paid for this sort of thing.  Shouldn't you compile it into some sort of outlook add-on and post it for sale someplace?
CERTIFIED EXPERT
Top Expert 2010

Commented:
Yeah, I probably should.  I don't for a couple of reasons.  One of those is that I've found lots and lots of functional sample code on the internet.  Code that's helped me a lot.  I enjoy the challenge of solving problems, and this is my way of giving something back.
Access more of Experts Exchange with a free account
Thanks for using Experts Exchange.

Create a free account to continue.

Limited access with a free account allows you to:

  • View three pieces of content (articles, solutions, posts, and videos)
  • Ask the experts questions (counted toward content limit)
  • Customize your dashboard and profile

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.