Need Help with filesearch Object 3

[Flo79]

Hi,

I have a query with file names (no extension)

I want to include a function that returns the path to the filename in the specified column.

The path should be a link to the file found

If no file is found nothing should be returned.

Here is the code I have thus far:

' strfilename should be the name of he column in my query which contains the filename to be searched for (no extension should be needed to e specified

Public Function FileLocation(strFileName As Variant) As Variant


Dim varResult As Variant
On Error GoTo End_Function

With Application.FileSearch
.FileName = strFileName
.LookIn = "C:\"
.SearchSubFolders = True
.Execute
varResult = .FoundFiles

End With

FileLocation = varResult

End_Function:
End Function

This Function Returns nothing.

Any help would be greatly appreciated...

Thanks in Advance.

Regards Flo79

 

[Flo79]

I Just found the following code which does what I am looking for with one exeption:

The file name specified requires an extension such as .mdb

I want to return all files matching my text string i.e.

"picture" could return the path to picture.tif or picture.jpg

Could someoe tell me how to modify the following code?

'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Function fReturnFilePath(strFilename As String, _
strDrive As String) As String

Dim varItm As Variant
Dim strFiles As String
Dim strTmp As String

If InStr(strFilename, ".") = 0 Then
MsgBox "Sorry!! Need the complete name", vbCritical
Exit Function
End If

strFiles = ""
With Application.FileSearch
.NewSearch
.LookIn = strDrive
.SearchSubFolders = True
.FileName = strFilename
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute > 0 Then
For Each varItm In .FoundFiles
strTmp = fGetFileName(varItm)
If strFilename = strTmp Then
fReturnFilePath = varItm
Exit Function
End If
Next varItm
End If
End With
End Function


Private Function fGetFileName(strFullPath) As String
Dim intPos As Integer, intLen As Integer
intLen = Len(strFullPath)
If intLen Then
For intPos = intLen To 1 Step -1
'Find the last \
If Mid$(strFullPath, intPos, 1) = "\" Then
fGetFileName = Mid$(strFullPath, intPos + 1)
Exit Function
End If
Next intPos
End If
End Function

Thanks!

 

[TrollBro]

Flo79

If the strfilename will never contain ".", you could rem those 4 lines as shown below, and then alter the " If strFilename = strTmp " line to read:

If strFilename = Left(strTmp, InStrRev(strTmp, ".") - 1)

code with alterations below. maybe it helps you.



Function freturnfilepath(strFilename As String, _
strDrive As String) As String

Dim varItm As Variant
Dim strFiles As String
Dim strTmp As String

' If InStr(strFilename, ".") = 0 Then
' MsgBox "Sorry!! Need the complete name", vbCritical
' Exit Function
' End If

strFiles = ""
With Application.FileSearch
.NewSearch
.LookIn = strDrive
.SearchSubFolders = True
.FileName = strFilename
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute > 0 Then
For Each varItm In .FoundFiles
strTmp = fGetFileName(varItm)

If strFilename = Left(strTmp, InStrRev(strTmp, ".") - 1) Then
freturnfilepath = varItm
Exit Function
End If
Next varItm
End If
End With
End Function


Private Function fGetFileName(strFullPath) As String
Dim intPos As Integer, intLen As Integer
intLen = Len(strFullPath)
If intLen Then
For intPos = intLen To 1 Step -1
'Find the last \
If Mid$(strFullPath, intPos, 1) = "\" Then
fGetFileName = Mid$(strFullPath, intPos + 1)
Exit Function
End If
Next intPos
End If
End Function

 

[Flo79]

Thank you TrollBro! That did the Trick.

I am now running into a new problem:

I am using an update query that uses the above function to update hyperlinks in a table.

When doing so, the text listed for the hyperlink (The text one clicks to open the link) gets changes, but the underlying link disapears.

Needless to say, I need the underlying link to be updated, not the text. Otherwise, all Hyperlinks become disfunctional.

Can I avoid this problem?

 

[PHV]

In the VBA help file have a look to the HyperLinkPart method to discover the meaning of the # character for hyperlinks.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[Remou]

Hi
Hyperlinks look something like:
Hello#LinkToHello.Dot
So you need to update something like:
FileLoc & "#" & FileLoc

 

[Flo79]

Thank you both for the tip using HyperlinkPart. I did't expect such a neat and easy solution for my problem. It now works flawlessly.

Thank you Again!

Cheers!

Flo79