Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 192
  • Last Modified:

Looking for specific attachments in Outlook

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?
0
kjanicke
Asked:
kjanicke
  • 6
  • 3
1 Solution
 
David LeeCommented:
Sure.  I'll make that change and get it posted as quick as I can (next 3-4 hours).
0
 
David LeeCommented:
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
0
 
kjanickeAuthor 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.
0
Free Backup Tool for VMware and Hyper-V

Restore full virtual machine or individual guest files from 19 common file systems directly from the backup file. Schedule VM backups with PowerShell scripts. Set desired time, lean back and let the script to notify you via email upon completion.  

 
David LeeCommented:
You're far too kind, but thanks!  Hope the server crash doesn't turn ugly.
0
 
kjanickeAuthor 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.  
0
 
David LeeCommented:
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.
0
 
David LeeCommented:
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
0
 
kjanickeAuthor 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?
0
 
David LeeCommented:
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.
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

  • 6
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now