Je cherche à trouver le "path" d'un dossier à partir d'un nom donné pour automatiser des choses dans notre BE avec solidworks.
Je précise que je n'ai que le nom du dossier et pas son chemin.
celà doit ressembler à quelque chose comme : F:\Affaires\???\NomDuDossier\...
Seulement pour le moment, j'arrive à trouver si il existe mais pas a récupérer son chemin d'accès, dont j'ai besoin pour la suite. Je n'ai dans la console que le retour "got it"
Avez vous des idées?
Voici mon code :
Sub FindFolder()
Dim searchFolderName As String searchFolderName = "F:\Affaires"
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 "NomDuDossier" Then Debug.Print subFolder.Name, subFolder.GetPath Debug.Print ("got it") End End If
Est-ce que les références Microsoft Scripting Runtime sont bien activées?
Ce code là fonctionne très bien chez moi:
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
L'ensemble est sensible à la casse donc bien faire attention. Si ça passe par Got It de toute façon c'est que le If fonctionne donc l'erreur est ailleurs.
Faut penser à vider la mémoire lorsque l'on fait appel à des fonctions de ce type. Je tenterai bien un Set FileSystem = nothing:Set SubFolder = Nothing juste avant le end qui est sous "Got It"
il semble que tu ai vu juste cependant, quand j'execute le code pour les premier dossiers ça fonctionne parfaitement. Mais pas pour les suivants... il faut dire que le serveur est chargé.
Peut-être tenter un exit sub au lieu de End. Puis mettre le Set FileSystem = Nothing dans la procédure principale en gros:
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
La dernière version du code fonctionne bien. Jusqu'au moment où on recherche un dossier situé très loin dans l'arborescence... Au cours de la recherche, si on rencontre un dossier système (du type System Volume Information), la procédure de recherche déraille: elle renvoie des sous-dossiers indéfinis et sans noms, mais retourne une valeur "True" au test de la conformité avec le nom recherché. D'où une chaîne vide et un résultat faux. Les attributs du dossier système parent n'indiquent pas un statut particulier : valeur égale à 22, à savoir répertoire, caché et système, rien d'inhabituel. A noter que ce sont les mêmes attributs que pour la racine du disque ("D:\") qui ne pose aucun problème.
Pour contourner le pb, je n'ai pas trouvé d'autre solution que de tester le nombre de sous-dossiers (nb = Folder.SubFolders.Count) avant la boucle de recherche, et de quitter la procédure s'il provoque une erreur (70). Dans le code original, le On Error Resume Next masque l'erreur.
J'ai également ajouté un booléen qui permet de stopper la recherche une fois que le dossier a été trouvé. Test qu'il faudra supprimer s'il peut exister plusieurs dossiers du même nom dans la recherche...
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
Il pourrait être utile de vérifier le nombre de caractères de la chaîne des chemins, histoire de savoir si c'est la limite de longueur du string path qui pose problème ou toute autre chose.
Autre chose à essayer ; autoriser Windows à gérer des longueurs de chemins plus importantes :
Dans l'éditeur de registre aller à HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\FileSystem\LongPathsEnabled , passer sa valeur à 1 et rebooter.
Le risque d'un débordement de la pile d'exécution de VBA est un aspect à considérer dans le cas d'une procédure récursive comme le doFolder de la macro. Sauf erreur de ma part, dans ce cas de recherche d'un dossier sur un disque, le nombre d'appels simultanés est au plus égal au nombre de dossiers du plus long chemin existant dans l'arborescence des répertoires. Soit quelques unités, voire quelques dizaines, probablement pas davantage. En tout cas pas de nature à provoquer un débordement, débordement qui serait signalé par une erreur.
A propos d'erreur: pendant la mise au point de la macro, il faut supprimer l'instruction On Error Resume Nextqui a pour effet de masquer les erreurs en continuant l'exécution en silence à la ligne suivant l'erreur. Vous pouvez d'ailleurs le vérifier sur la toute première version de votre macro: une erreur se produit (70: permission refusée), et la consultation à ce stade de la propriété Folder.path vous donne le coupable: System Volume Information.
Si le problème sur votre serveur est de même nature que sur le disque C:, c'est à dire un dossier non accessible, c'est peut-être par ce moyen simple que vous le pourrez l'identifier, en laissant se produire l'erreur à l'exécution...
Quant à faire la recherche sur une partie seulement du nom, ça ne me paraît pas devoir apporter un gain significatif. Il pourra s'agir d'une amélioration de la rapidité de traitement, une fois la macro fonctionnelle dans tous les cas.
m.blt, effectivement ça semble logique. Je n'ai pas l'instruction On Error Resume Next car j'utilise le code que tu as posté ci-dessus.
Je ne peux malheureusement pas avoir le dossier qui pose souci en erreur car VBA plante complètement lors de l'execution sur F:\ lorsque je dépasse les 4 ou 5 premier dossiers...
Pour ce qui est du filtrage par lettre, une autre option : limiter la recherche au premier sous dossier? je n'ai pas besoin d'aller plus loin et ça m'éviterais de tomber sur des dossier avec permission refusé? Pour ce qui est du F:\Affaires sur lequel je cherche, normalement, j'ai tout les droits.
Sylk, je vais modifier la clef de registre et essayer de nouveau.
m.blt, après plusieurs essais, j'arrive enfin à avoir des retours dans le terminal! effectivement il y'a des dossiers system ou des dossiers pour lequels je n'ai pas les droits!!! dès que le code en rencontre un, il se plante complètement..
