I'm trying to find the "path" of a folder from a given name to automate things in our design office with solidworks.
I specify that I only have the name of the file and not its path.
it should look something like: F:\Business\??? \FolderName\...
Only for the moment, I can find if it exists but not to recover its path, which I need for the future. I only have the "got it" feedback in the console
Do you have any ideas?
Here's my code:
Sub FindFolder()
Dim searchFolderName As String searchFolderName = "F:\Deals"
Dim FileSystem as Object
Set FileSystem = CreateObject("Scripting.FileSystemObject")
doFolder FileSystem.GetFolder(searchFolderName)
End Sub
Sub doFolder(Folder) Dim subFolder On Error Resume Next For Each subFolder In Folder.SubFolders If subFolder.Name Like "FolderName" Then Debug.Print subFolder.Name, subFolder.GetPath Debug.Print ("got it") End End If
Are Microsoft Scripting Runtime credentials enabled?
This code works very well for me:
Sub FindFolder()
Dim searchFolderName As String
searchFolderName = "C:\test"
Dim FileSystem As Object
Set FileSystem = CreateObject("Scripting.FileSystemObject")
doFolder FileSystem.GetFolder(searchFolderName)
End Sub
Sub doFolder(Folder)
Dim subFolder As Scripting.Folder
On Error Resume Next
For Each subFolder In Folder.SubFolders
If subFolder.Name Like "SW2020" Then
Debug.Print subFolder.Name, subFolder.Path
Debug.Print ("got it")
End
End If
doFolder subFolder
Next subFolder
End Sub
The whole thing is sensitive to breakage so be careful. If it goes through Got It anyway, it's because the If works so the error is elsewhere.
You have to think about emptying the memory when using functions of this type. I'll try a Set FileSystem = nothing:Set SubFolder = Nothing just before the end which is under "Got It"
It seems like you were right though, when I run the code for the first folders it works perfectly. But not for the next ones... It must be said that the server is loaded.
Maybe try an exit sub instead of End. Then put the Set FileSystem = Nothing in the main procedure basically:
Sub FindFolder()
Dim searchFolderName As String
searchFolderName = "C:\test"
Dim FileSystem As Scripting.FileSystemObject
Set FileSystem = CreateObject("Scripting.FileSystemObject")
doFolder FileSystem.GetFolder(searchFolderName)
Set FileSystem = Nothing
End Sub
Sub doFolder(Folder)
Dim subFolder As Scripting.Folder
On Error Resume Next
For Each subFolder In Folder.SubFolders
If subFolder.Name Like "SW2020" Then
Debug.Print subFolder.Name, subFolder.Path
Debug.Print ("got it")
Set subFolder = Nothing
exit sub
End If
doFolder subFolder
Next subFolder
End Sub
The latest version of the code works fine. Until the moment when you look for a folder located very far in the tree... During the search, if you come across a system folder (such as System Volume Information), the search procedure goes off the rails: it returns undefined subfolders without names, but returns a value of "True" when tested for compliance with the search name. Hence an empty string and a false result. The attributes of the parent system folder do not indicate a particular status: value of 22, i.e. directory, hidden, and system, nothing unusual. Note that these are the same attributes as for the root of the disk ("D:\") which is not a problem.
To get around the pb, I found no other solution than to test the number of subfolders (nb = Folder.SubFolders.Count) before the search loop, and to exit the procedure if it causes an error (70). In the original code, the On Error Resume Next hides the error.
I also added a boolean that allows you to stop the search once the folder has been found. Test that will have to be deleted if there can be several folders of the same name in the search...
Option Explicit
Dim bFindFldr As Boolean
'==============================================================='
Sub FindFolder()
Dim searchFolderName As String
Dim FileSystem As Scripting.FileSystemObject
searchFolderName = "D:\"
Set FileSystem = CreateObject("Scripting.FileSystemObject")
bFindFldr = False
If Not bFindFldr Then doFolder FileSystem.GetFolder(searchFolderName)
Set FileSystem = Nothing
Debug.Print ("Fin de la recherche")
End Sub
'==============================================================='
Sub doFolder(Folder As Object)
Dim subFolder As Scripting.Folder
Dim nb As Integer
On Error GoTo erreur
nb = Folder.SubFolders.Count
For Each subFolder In Folder.SubFolders
If Not (subFolder.Attributes And System) Then
If Not bFindFldr Then ' Si le dossier n'a pas encore été trouvé...
If subFolder.Name Like "ACER" Then
Debug.Print subFolder.Name, subFolder.Path
Debug.Print ("got it")
bFindFldr = True
End If
If Not bFindFldr Then doFolder subFolder ' Poursuite récursive de la recherche si le dossier n'est pas trouvé
Else
Debug.Print (" - Dépilage: " & subFolder.Path) ' Permet d'afficher le "dépilage" des fonctions toujours activées après avoir trouvé le dossier
End If
End If
Next subFolder
Exit Sub
erreur: Debug.Print (" *** Dossier système *** " & Folder.Path)
End Sub
It might be useful to check the number of characters in the path chain, just to know if it's the string path length limit that's the problem or something else entirely.
Another thing to try; Allow Windows to handle longer path lengths:
In the registry editor go to HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\FileSystem\LongPathsEnabled , change its value to 1 and reboot.
The risk of an overflow of the VBA execution stack is an aspect to consider in the case of a recursive procedure such as the macro's doFolder . Unless I'm mistaken, in this case of searching for a folder on a disk, the number of simultaneous calls is at most equal to the number of folders of the longest path existing in the directory tree. That is to say a few units, or even a few dozen, probably no more. In any case, it is not likely to cause an overflow, an overflow that would be signalled by an error.
Speaking of errors: during the development of the macro, the On Error Resume Next statement must be deleted , which has the effect of hiding the errors by continuing the execution silently on the line following the error. You can check this on the very first version of your macro: an error occurs (70: permission denied), and looking at the Folder.path property at this point gives you the culprit: System Volume Information.
If the problem on your server is of the same nature as on the C: disk, i.e. a folder that is not accessible, it may be by this simple means that you will be able to identify it, by letting the error occur at runtime...
As for doing the research on only part of the name, it doesn't seem to me to bring a significant gain. This could be an improvement in processing speed, once the macro is functional in all cases.
Mr. BLT, indeed it seems logical. I don't have the On Error Resume Next statement because I'm using the code you posted above.
Unfortunately, I can't get the folder that is causing a problem because VBA crashes completely when running on F:\ when I exceed the first 4 or 5 folders...
As for the filtering by letter, another option: limit the search to the first sub-folder? I don't need to go any further and it would prevent me from coming across folders with permission denied? As for the F:\Business I'm looking for, normally, I have all the rights.
Sylk, I'm going to change the registry key and try again.
Mr. BLT, after several tries, I finally manage to get feedback in the terminal! Indeed there are system folders or folders for which I don't have the rights!! As soon as the code encounters one, it crashes completely.
