Alternative to FileSearch for Finding Directories

[acunnane]

I was extremely excited when I found FileSearch - it seemed like the
solution to an issue I hadn't manage to get round. Until I found out
the Filesearch isn't actually reliable and this was an issue on my
machine. So now I'm looking for an alternative.

I have a collection of directories which are named by a 12 digit part
number and a part name. I also have an excel sheet with the list of
part numbers in. I want to test to see if all the directories exist .
.. .without using filesearch.

Does anyone have any brilliant ideas?

Thanks

 

[Don Guillett]

look in vba help for DIR

 

[Guest]

If I wanted to check for C:\Data1\Data3 I could do

Sub abc()
Dim fs As Object, dr As Object
Dim fldr As Object, fldr1 As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set dr = fs.Drives("C")
Set fldr = dr.RootFolder
On Error Resume Next
Set fldr1 = dr.RootFolder.SubFolders("Data1").SubFolders("Data3")
On Error GoTo 0
If fldr1 Is Nothing Then
MsgBox "C:\Data1\Data3 does not exist"
Else
MsgBox fldr1.Path & " was found"
End If
End Sub

 

[Andy]

Thanks guys for your quick responses.

- I looked at DIR and maybe I'm not using it right, but it only seems
to find files rather than directories:
MsgBox(Dir(MyDir & "\08*")) doesn't find a directory named 08-000
or even 08
'MyDir is the path that contains the directory

- I tried your code Tom and it works nicely. However, I don't know the
full name of the directory I'm searching for, I only know the part
number which only makes up the first 12 digits of the directory, ie:
'01-000000-00 Left Flangy'
I did try a long shot to adapt the code using the 'Left' object, but to
no avail.

Andy

 

[Norman Jones]

Hi AC,

As an alternative, try:

'=============>>
Public Sub TesterA1()
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim rCell As Range
Const myPath As String = "C:\"

Set WB = Workbooks("YourBook.xls") '<<==== CHANGE
Set SH = WB.Sheets("Sheet1") '<<==== CHANGE
Set rng = SH.Range("A2:A20") '<<==== CHANGE

For Each rCell In rng.Cells
With rCell
.Select
.Offset(0, 1).Value = DirectoryExists(myPath & .Value)
End With
Next rCell
End Sub

'------------->

Public Function DirectoryExists(fldr As String)
Dim FSO As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
DirectoryExists = FSO.FolderExists(fldr)
End Function

End Function
'<<=============

Or, dispense with the Tester macro, and use the function directly in the
worksheet, e.g.:

=DirectoryExists($C$1 & A1)

where C1 holds the folder path

 

[Andy]

I like the function, seems like it could have multiple uses, but I
can't get it to find a directory if it only has part of the directory
name.

Am I trying to attempt an impossible task in excel?

Andy

 

[Jim Cone]

One more way...
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware

Sub CallFolderFunction()
Dim strFolder As String
'Specify the partial folder name - note use of "*"
strFolder = "*123456*"
'Specify the top folder in the call...
Call IsFolderThere("C:\Documents and Settings\user\My Documents", strFolder)
End Sub
'---
Private Function IsFolderThere(ByRef strPath As String, ByRef strFolder As String)
'Jim Cone - San Francisco, USA - July 2006
'Requires project reference to "Microsoft Scripting Runtime" library
'Determines whether a folder exists if only a partial folder name is known.
On Error GoTo ScriptErr
Dim objFSO As Scripting.FileSystemObject
Dim objSubFolder As Scripting.Folder
Dim objFolder As Scripting.Folder
Dim strMsg As String

Application.StatusBar = "FINDING FOLDER"
'Bring it to life...
Set objFSO = New Scripting.FileSystemObject

'Check for top folder
On Error Resume Next
Set objFolder = objFSO.GetFolder(strPath)
If Err.Number <> 0 Then
MsgBox "No Top Folder:"
GoTo FinishUp
End If
On Error GoTo ScriptErr

For Each objSubFolder In objFolder.SubFolders
'Verify secondary folder exists...
If objSubFolder.Name Like strFolder Then
strMsg = objSubFolder.Path
MsgBox "Folder found__ " & strMsg & " "
GoTo FinishUp
End If
'Call recursive function
DoTheSubFolders objSubFolder, strFolder, strMsg
If Len(strMsg) Then Exit For
Next 'objsubfolder

If Len(strMsg) = 0 Then MsgBox "Folder Not Found "

FinishUp:
On Error Resume Next
Application.StatusBar = False
Set objFSO = Nothing
Set objFolder = Nothing
Set objSubFolder = Nothing
Exit Function

ScriptErr:
MsgBox "Error " & Err.Number & " " & Err.Description
GoTo FinishUp
End Function
'---
'Recursive function
Function DoTheSubFolders(ByRef objFolders As Scripting.Folder, _
ByRef strTitle As String, ByRef strM As String)
Dim scrFolder As Scripting.Folder

For Each scrFolder In objFolders.SubFolders
If scrFolder.Name Like strTitle Then
strM = scrFolder.Path
MsgBox "Folder found__ " & strM & " "
Set scrFolder = Nothing
Exit Function
End If
'If there are more sub folders then go back and run function again.
If scrFolder.SubFolders.Count > 0 Then
DoTheSubFolders scrFolder, strTitle, strM
End If
Next 'scrFolder
Set scrFolder = Nothing
End Function
'------------------------------------

I was extremely excited when I found FileSearch - it seemed like the
solution to an issue I hadn't manage to get round. Until I found out
the Filesearch isn't actually reliable and this was an issue on my
machine. So now I'm looking for an alternative.

I have a collection of directories which are named by a 12 digit part
number and a part name. I also have an excel sheet with the list of
part numbers in. I want to test to see if all the directories exist .
.. .without using filesearch.

Does anyone have any brilliant ideas?

Thanks

 

[NickHK]

Andy,
Look at the second argument to the Dir function; you can use vbDirectory.

NickHK

 

[Andy]

Brilliant! Thanks for your help. I never realised there was so much
knowledge hiding in these groups.

Andy