Trouble with XL2007+ "Application.FileSearch" Replacement Conversion

[DFragnDragn]

I can't seem to respecify the path properly with a Dir or the fso conversion for the retired FileSearch.

I'm just mucking it up with

Set fso = CreateObject("Scripting.FileSystemObject")

Function Find_File(file_to_find As String) As String
Dim found_file As Variant
Dim wb As Workbook
Dim response As Integer
With [COLOR=DarkRed]Application.FileSearch[/COLOR]
    For drive_char = 65 To 90 
        .NewSearch
        .filename = "filename"
        .LookIn = Chr$(drive_char) & ":"
        .FileType = msoFileTypeExcelWorkbooks
        .SearchSubFolders = True
If .Execute() > 0 Then
            Find_File = .FoundFiles(1)
            Exit Function
        End If
    Next
End With
Find_File = "Not Found"
End Function

And is Called via:

Dim file_location As String
file_location = Find_File("xyz.xltm")
MsgBox file_location

 

[Andrew Poulsom]

Maybe you can use the UDF I posted here:

http://www.mrexcel.com/forum/showthread.php?p=2638506

 

[DFragnDragn]

Thanks Andrew.

It looks good but had to re-declare the function for 64-bit with ptrsafe.

I'm having a problem invoking the function though.
Any suggestions?

Option Explicit

Private Declare [COLOR=Black]PtrSafe[/COLOR] Function SearchTreeForFile Lib "xyz.xltm" (ByVal RootPath As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As Long
Private Const MAX_PATH = 260
 
Function findfile(path As String, Filename As String) As String
    Dim tempStr As String, Ret As Long
    tempStr = String(MAX_PATH, 0)
    If Right(path, 1) <> "\" Then path = path & "\"
    Ret = SearchTreeForFile(path, Filename, tempStr)
    If Ret <> 0 Then
        findfile = Left$(tempStr, InStr(1, tempStr, Chr$(0)) - 1)
    Else
        findfile = "Not found!"
    End If
End Function

 

[Andrew Poulsom]

The function is in "imagehlp" not in "xyz.xltm" - it's a Windows API function.

 

[DFragnDragn]

It seems your suggestion [I like it - worth saving] depends on a specific Dir.

I need to search all unknown Drive designations including active removable drives.

My original iteration is very close with the exception of the retired Application.FileSearch procedure.

This is all part of a security procedure I'm writing.
If someone attempts to copy the WB and the users HD serial number doesn't match the original serial #'s value after it's opened more then once it then closes the WB.

I'm also attempting to get it to find & kill all potential copies on unknown drive designations including removable drives of the illicit users machine.