Code to search for a File and then open it

[JohnLee]

Good afternoon folks,

I'm looking for some assistance on how to write some code that will search a known drive and folder structure for a tif file and on finding it, open that tif file.

The known drive/folder structure is as follows:

M:\CustomerSatisfaction\StdDGImages

or it could have the full path as follows:

\\prdfs01\QUESTIONS\CustomerSatisfaction\StdDGImages

and then there are the following folders which contain any number of tif images:

01_Q
02_Q
03_Q
04_Q
05_Q
06_Q
07_Q
10_Q
11_Q
12_Q
13_Q
14_Q
17_Q
18_Q
19_Q
20_Q
21_Q
23_Q
24_Q
28_Q
29_Q
30_Q
31_Q
32_Q
33_Q
34_Q
35_Q
36_Q
37_Q
38_Q
39_Q
AR_Q
HE_Q
SKY_SKY3B

I would like to have a button in a form that the end user clicks and they then enter the name of the tif file they are looking for and on pressing enter the file is searched for and if found it is automatically opened up for them to see, if it is not found then a message "File Not Found" is displayed.

I Believe that I will need something like this:

[FONT=Times New Roman]Dim FS As FileSystemObject [/FONT]
[FONT=Times New Roman]Dim filenum As Integer [/FONT]
[FONT=Times New Roman]Dim tmp As String[/FONT]
[FONT=Times New Roman]Dim Folder As Folder[/FONT]
[FONT=Times New Roman]Dim subFolder As Folder[/FONT]
[FONT=Times New Roman]Dim File As File [/FONT]
[FONT=Times New Roman]Dim TiffFilePath[/FONT]
[FONT=Times New Roman]Dim NameOfFile[/FONT]
[FONT=Times New Roman]Dim FileNameWithExt [/FONT]
[FONT=Times New Roman]Dim strTemp As String [/FONT]
[FONT=Times New Roman]Dim FileLoc As String[/FONT]
 
[FONT=Times New Roman]Const ForReading = 1[/FONT]
 
[FONT=Times New Roman][FONT=Times New Roman]Set FS = CreateObject("Scripting.FileSystemObject")[/FONT][/FONT]
 
[FONT=Times New Roman][FONT=Times New Roman]TifFilePath = "B:\"[/FONT]
[/FONT]
[FONT=Times New Roman][FONT=Times New Roman]If Not FS.FolderExists(TifFilePath) Then[/FONT]
[FONT=Times New Roman]MsgBox "Folder Doesn't Exist", , "Reading Tif Files"[/FONT]
[FONT=Times New Roman]       End[/FONT]
[FONT=Times New Roman]End If[/FONT]
 
[FONT=Times New Roman][FONT=Times New Roman]Set Folder = FS.GetFolder(TifFilePath)[/FONT][/FONT][/FONT]
 
[FONT=Times New Roman][FONT=Times New Roman][COLOR=red]It's when I get to this point that I've got stuck, I don't know how to structure the code required to do the search and on finding the tif file open it.[/COLOR][/FONT][/FONT]

I'm slowly learning about these things but I've got really stuck here, so any help would be greatly appreciated.

Regards

John

Edit: an example tif file I might search for is: 0H214_2CJ0001905.tif.

 

[TJPoorman]

Do a search for recursive folder searching. I will post the code I have in a little bit when I get a minute.

 

[TJPoorman]

This is the code for the recursive search function:

Public Function RecursiveDir(colFiles As Collection, _
                            strFolder As String, _
                            strFileSpec As String, _
                            bIncludeSubfolders As Boolean)
 
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
 
On Error Resume Next
 
'Add files in strFolder matching strFileSpec to colFiles
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)

Do While strTemp <> vbNullString
    colFiles.Add strFolder & strTemp
    strTemp = Dir
Loop
 
If bIncludeSubfolders Then
    'Fill colFolders with list of subdirectories of strFolder
    strTemp = Dir(strFolder, vbDirectory)
    Do While strTemp <> vbNullString
        If (strTemp <> ".") And (strTemp <> "..") Then
            If InStr(1, strTemp, "?") = 0 Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                    colFolders.Add strTemp
                End If
            End If
        End If
        strTemp = Dir
    Loop
    'Call RecursiveDir for each subfolder in colFolders
    For Each vFolderName In colFolders
        Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
    Next vFolderName
End If
End Function

Then call the function from your button like so:

Dim colFiles As New Collection

RecursiveDir colFiles, "[COLOR=red]YourFolderNameHere[/COLOR]", "*.tif", True
 
Dim vFile As Variant

For Each vFile In colFiles
    If vFile Like "*[COLOR=red]WhateverYourSearchingFor[/COLOR]*" Then
        Debug.Print vFile
    End If
Next vFile

 

[JohnLee]

Hi TJPoolman,

Thank you for the pointer and of course the code, I've read a few posts on the internet on the subject, it's quite involved, I think I have a basic understanding of the subject, I'm still learning about such things. I'll deploy the code you kindly supplied and let you know how I get on.

Thanks once again for your help in this.

Regards

John

 

[JohnLee]

Hi TJPoolman,

I've deployed the code you supplied as follows:

I created a new module and callled it mod_SearchQuesDir and copied the code named Public Function RecursiveDir into this module.

I then created a button and called it cmdFindTifFile and in the on click event I put the code below in:

Private Sub cmdFindTifFile_Click()
Dim colFiles As New Collection
[COLOR=red]Dim TifImage As String[/COLOR]
[COLOR=red][/COLOR] 
[COLOR=red]TifImage = InputBox("Policy No:", "Policy No To Search For")[/COLOR]
 
RecursiveDir colFiles, "[URL="file://\\prdfs01\QUESTIONS\Customer"][COLOR=red]\\prdfs01\QUESTIONS\Customer[/COLOR][/URL][COLOR=red] Satisfaction\StdDGImages[/COLOR]", "*.tif", True
 
Dim vFile As Variant
For Each vFile In colFiles
    If vFile Like "[COLOR=red]TifImage[/COLOR]*" Then
        Debug.Print vFile
    End If
Next vFile
End Sub

The code in red are what I added according to my understanding of what you provided.

However when I click the button and put in "0H214_2CJ0001905" in the input box I get the following error message:

Microsoft Visual Basic

Compile Error:

Sub or Function Not Defined

See attached snap shots of that code block. I don't understand what that means. Your assistance once again would be appreciated.

Regards

John

 

[pr2-eugin]

Trailing Slash is a function that needs to be in the module too.. I think this is the function..

Public Function TrailingSlash(varIn As Variant) As String
    If Len(varIn) > 0& Then
        If Right(varIn, 1&) = "\" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & "\"
        End If
    End If
End Function

Code Author : Allen Browne. List Files recursively.

 

[JohnLee]

Hi Pr2-Eagin,

Thank you, your code made a difference. Having ran the code again, something does appear to have happen, but no results appeared. I was expecting the file to be opened once found, but this hasn't happen.

To take a step back, after you supplied your code for the trailing slash, I ran the whole process again, the database became unresponsive and I think that was because of the high volume of tif files in the drive folder structure 76,425 tif files over 34 folders, so I stopped the process by ending the session via the task manager and then narrowed down the folder to search [as this would be known] and ran the process again. The database didn't go into non responsive mode but certainly did something, but not what I was hoping for.

What I am looking to try and do is to search these folders for a policy image [tif file] and on finding it, for it to be opened and displayed on screen automatically, so it would appear to me that I am missing additional actions to acheive that, is there something that can on finding a file then cause that file to be opened.

Any assistance/pointers would be most appreciated.

Regards

John

 

[pr2-eugin]

Try this John.. I am unable to help you with the speed for processing the code.. But this should help you with opening the file..

Private Sub cmdFindTifFile_Click()
    Dim colFiles As New Collection
    Dim TifImage As String, basePath As String, baseExt As String
    
    basePath = "\\prdfs01\QUESTIONS\Customer Satisfaction\StdDGImages"
    baseExt = "*.tif"
    TifImage = InputBox("Policy No:", "Policy No To Search For")
     
    RecursiveDir colFiles, basePath, baseExt, True
     
    Dim vFile As Variant
    For Each vFile In colFiles
        If Mid(vFile, InStrRev(vFile, "\") + 1) = TifImage & Replace(baseExt, "*", "") Then
            Application.FollowHyperlink vFile
            Exit For
        End If
    Next vFile
End Sub

 

[JohnLee]

Hi Paul [Pr2-Eagan,

Thank you very much for your help, you code worked a treat. Your point on the time it would take is very important, I narrowed the search down a bit, by adding \01_Q at the end of the basePath to reduce the time taken to do the search and open the file.

I think that doing a search over so many tif files will be extremely time consuming and that restricting the search to the known folder location would be better, however other folders hold even more than the one I was testing against, and therefore begs the question is this really the best way to approach this.

It works great there is no doubt about that, but the time taken just 3,559 files was about 2 minutes, so I guess I can triple or quaruple that for 9,742 files that currentle exist in another folder. So based on that it would take about 45 minutes for a search of 76,425 files, which really isn't good enough if you need to find something much more quickly than that.

I think I need to consider maybe setting up individual folder searches using this method to keep the time it takes as small as possible, so I'll be explaining that to my associates who requested this functionality.

But this is most definately code worth having for other aspects of our work where the volume of files are not so large.

Thank you very much for your assistance both you and TJ Poolman most appreciated.

Regards

John

 

[pr2-eugin]

John I am not sure how comfortable you would be with this idea I am about to introduce. I should warn you, it is a painstaking task to begin with, but will help you loads better in the future..

It is as simple as creating a new field in the table say pathToImage, insert the approporiate path into the filed for each customer ID (this is the very hard part, this I think can be done with some messy code, as this is a one time only process. In future you can make the path added automatically).

Once that is done, your code will be as simple as..

Private Sub cmdFindTifFile_Click()
    Dim TifImage As String, vFile As String
    
    TifImage = InputBox("Policy No:", "Policy No To Search For")
    
    vFile = Nz(DLookUp("pathToImage", "theTableName", "policyNumberFieldName = '" & TifImage & "'"), "NA")
    
    If vFile <> "NA" Then 
        Application.FollowHyperlink vFile
    Else
        MsgBox "No TIF image found for the Policy number : " & TifImage, vbInformation
    End If
End Sub

What do you think?

And BTW,

Hi Paul [Pr2-Eagan,

You can call me Paul forget about my username..

 

[JohnLee]

Hi Paul,

I see where your coming from, and thinking about that I have another process in my database that imports the text file data that pertains to those tif image files and I import the image path along with it which I use when I am carrying out my QA checking of the data. I convert the text data to a hyperlink format which enables me to open up the image and compare that data against the text file data.

The images for this particular process are output to a different location which isn't available to my associates because of the scanning system that uses it doesn't permit those users access to that particular area of the network, but as the administrator of the system I do have access to those image files. I have a process that copies those tif images from the location they are output to, renames them to the Policy number in their new location, so I'm now thinking I could create a hyperlink to those images in the Drive location we've been working on in my database and make that available to my associates, the search for the Policy number within the database would be considerable quicker than already identified.

Thanks for the prompt and causing me to re-think what I'm doing with the original data.

Your suggestion is certainly worthy of trying, if this new train of thought doesn't pan out. I've certainly learnt a great deal about file searching that's for sure.

Thanks once again Paul.

Regards

John

 

[pr2-eugin]

Glad to help John..

Well what I proposed was only a suggestion, you can try it. I am sure there could be simpler methods available too.. Good luck..