I have a file name, e.g. SuperFile.xlsm. It is not opened, but I want to find where in the directory it is located - thus the path to get to it. Everything I have researched refers to a currently opened file. I do not want to open it, I want only to obtain the directory path to get to it. Any help will be greatly appreciated!!
-
If you would like to post, please check out the MrExcel Message Board FAQ and register here. If you forgot your password, you can reset your password.
VBA code to find path for a "closed" file
- Thread starter D_Duck
- Start date
Logit
Well-known Member
- Joined
- Aug 31, 2016
- Messages
- 4,846
This may be more than you are looking for as it will search your entire computer hard drive:
VBA Code:
Option Explicit
Dim fso As Object
Dim fld As Object
Dim r As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" _
Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
' Taken from http://support.microsoft.com/kb/291573
Private Function GetDriveStrings() As String
' Wrapper for calling the GetLogicalDriveStrings API
Dim result As Long ' Result of our api calls
Dim strDrives As String ' String to pass to api call
Dim lenStrDrives As Long ' Length of the above string
' Call GetLogicalDriveStrings with a buffer size of zero to
' find out how large our stringbuffer needs to be
result = GetLogicalDriveStrings(0, strDrives)
strDrives = String(result, 0)
lenStrDrives = result
' Call again with our new buffer
result = GetLogicalDriveStrings(lenStrDrives, strDrives)
If result = 0 Then
GetDriveStrings = ""
Else
GetDriveStrings = strDrives
End If
End Function
' adapted from https://support.microsoft.com/kb/185601/EN-US
Sub FindFile(ByVal sFol As String, sFile As String)
Dim tFld As Object, tFil As Object, FileName As String
Dim foundFile As String
On Error GoTo Catch
Set fld = fso.GetFolder(sFol)
FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or vbReadOnly)
Do While Len(FileName) <> 0
foundFile = fso.BuildPath(fld.Path, FileName)
r = r + 1
Range("A" & r).Value = foundFile
FileName = Dir ' Get next file
DoEvents
Loop
Application.StatusBar = "Searching " & fld.Path
If fld.SubFolders.Count > 0 Then
For Each tFld In fld.SubFolders
DoEvents
FindFile tFld.Path, sFile
Next tFld
End If
Exit Sub
Catch:
FileName = ""
Resume Next
End Sub
'"Bone Survey.wps"
Sub bSearch()
Dim strName As String
Dim ds As String
Dim i As Integer
Dim x, y As Integer
Sheets("Sheet1").Range("A2:C2").Value = ""
Sheets("Sheet1").Range("B2").Value = Now
' Change filename here (or prompt for it)
strName = Application.InputBox(prompt:="Enter Full File Name", Type:=2)
Set fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
Range("A:A").ClearContents
Range("A1").Value = "File"
r = 1
ds = GetDriveStrings
For i = 1 To Len(ds) Step 4
FindFile Mid(ds, i, 3), strName
Next i
Range("A1").EntireColumn.AutoFit
Application.StatusBar = False
Application.ScreenUpdating = True
Sheets("Sheet1").Range("C2").Value = Now
End Sub
Upvote
0
Solution
Thank you VERY MUCH for the reply! I will try this and hopefully can make it work. Will let you know how it works out ...
Upvote
0
WELLLL ... It works!!! Unfortunately, as you stated, it does search the entire C:\ drive (26 minutes). The contents of this code is in many instances above my current skill level, although I am going to see if I can condense the search to only Excel files. I really do appreciate your response though - at least I can obtain my answer, albeit by an extended process.
Upvote
0
Similar threads
