Ik probeer het "pad" van een map van een bepaalde naam te vinden om dingen in ons ontwerpbureau te automatiseren met solidworks.
Ik geef aan dat ik alleen de naam van het bestand heb en niet het pad.
het zou er ongeveer zo uit moeten zien: F:\Business\??? \Mapnaam\...
Alleen op dit moment kan ik erachter komen of het bestaat, maar niet om zijn pad te hervinden , dat ik nodig heb voor de toekomst. Ik heb alleen de "begrepen" feedback in de console
Heb je ideeën?
Hier is mijn code:
Sub FindFolder()
Dim searchFolderName As String searchFolderName = "F:\Deals"
Dim FileSystem als object
Set FileSystem = CreateObject("Scripting.FileSystemObject")
doFolder FileSystem.GetFolder(searchFolderName)
Einde Sub
Sub doFolder(Map) Submap dimmen Bij fout Hervatten Volgende Voor elke submap in map.Submappen Als subFolder.Name "FolderName" leuk vindt, dan Debug.Print subFolder.Name, subFolder.GetPath Debug.Print ("begrepen") Einde Einde als
Zijn Microsoft Scripting Runtime-referenties ingeschakeld?
Deze code werkt heel goed voor mij:
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
Het geheel is gevoelig voor breuk, dus wees voorzichtig. Als het toch door Got It gaat, is dat omdat de If werkt, dus de fout is ergens anders.
U moet nadenken over het legen van het geheugen bij het gebruik van dit soort functies. Ik probeer een Set FileSystem = niets:Set SubFolder = Niets net voor het einde dat onder "Got It" staat
Het lijkt erop dat je gelijk had wel, als ik de code voor de eerste mappen uit te voeren, werkt het perfect. Maar niet voor de volgende... Het moet gezegd worden dat de server is geladen.
Probeer misschien een exit sub in plaats van End. Zet vervolgens de Set FileSystem = Nothing in de hoofdprocedure in principe:
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
De laatste versie van de code werkt prima. Tot het moment dat je op zoek gaat naar een map die heel ver in de boom staat... Als u tijdens het zoeken een systeemmap tegenkomt (zoals System Volume Information), ontspoort de zoekprocedure: het retourneert niet-gedefinieerde submappen zonder namen, maar retourneert een waarde van "True" wanneer wordt getest op naleving van de zoeknaam. Vandaar een lege string en een vals resultaat. De attributen van de bovenliggende systeemmap geven geen bepaalde status aan: waarde van 22, d.w.z. directory, verborgen en systeem, niets ongewoons. Merk op dat dit dezelfde attributen zijn als voor de root van de schijf ("D:\"), wat geen probleem is.
Om de pb te omzeilen, vond ik geen andere oplossing dan het aantal submappen (nb = Folder.SubFolders.Count) te testen vóór de zoeklus, en de procedure te verlaten als het een fout veroorzaakt (70). In de originele code verbergt On Error Resume Next de fout.
Ik heb ook een boolean toegevoegd waarmee je het zoeken kunt stoppen zodra de map is gevonden. Test die moet worden verwijderd als er meerdere mappen met dezelfde naam in de zoekopdracht kunnen staan...
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
Het kan handig zijn om het aantal tekens in de padketen te controleren, gewoon om te weten of het de limiet voor de lengte van het tekenreekspad is die het probleem is of iets heel anders.
Nog iets om te proberen; Sta Windows toe om langere padlengtes te verwerken:
Ga in de register-editor naar HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\FileSystem\LongPathsEnabled, verander de waarde in 1 en start opnieuw op.
Het risico van een overloop van de VBA-uitvoeringsstack is een aspect waarmee rekening moet worden gehouden in het geval van een recursieve procedure zoals de doFolder van de macro. Als ik me niet vergis, is in dit geval van het zoeken naar een map op een schijf het aantal gelijktijdige aanroepen hoogstens gelijk aan het aantal mappen van het langste pad dat in de mappenstructuur bestaat. Dat wil zeggen een paar eenheden, of zelfs een paar tientallen, waarschijnlijk niet meer. In ieder geval is het niet waarschijnlijk dat het een overloop veroorzaakt, een overloop die zou worden gesignaleerd door een fout.
Over fouten gesproken: tijdens de ontwikkeling van de macro moet de On Error Resume Next-instructie worden verwijderd , wat tot gevolg heeft dat de fouten worden verborgen door de uitvoering geruisloos voort te zetten op de regel die volgt op de fout. U kunt dit controleren op de allereerste versie van uw macro: er treedt een fout op (70: toestemming geweigerd), en als u op dit moment naar de eigenschap Folder.path kijkt, krijgt u de boosdoener: System Volume Information.
Als het probleem op uw server van dezelfde aard is als op de C:-schijf, d.w.z. een map die niet toegankelijk is, kan het zijn dat u op deze eenvoudige manier het kunt identificeren, door de fout tijdens runtime te laten optreden...
Wat betreft het doen van onderzoek naar slechts een deel van de naam, het lijkt mij geen significante winst op te leveren. Dit kan een verbetering van de verwerkingssnelheid zijn, zodra de macro in alle gevallen functioneel is.
Bedankt dat je de tijd hebt genomen om me te helpen.
Meneer BLT, het lijkt inderdaad logisch. Ik heb de On Error Resume Next-verklaring niet omdat ik de code gebruik die je hierboven hebt gepost.
Helaas kan ik de map die een probleem veroorzaakt niet krijgen omdat VBA volledig crasht wanneer het op F:\ draait wanneer ik de eerste 4 of 5 mappen overschrijd...
Wat betreft het filteren op letter, een andere optie: beperk het zoeken tot de eerste submap? Ik hoef niet verder te gaan en het zou voorkomen dat ik mappen tegenkom met toestemming geweigerd? Wat betreft de F:\Business waar ik naar op zoek ben, normaal gesproken heb ik alle rechten.
Sylk, ik ga de registersleutel wijzigen en het opnieuw proberen.
Meneer BLT, na verschillende pogingen lukt het me eindelijk om feedback te krijgen in de terminal! Er zijn inderdaad systeemmappen of mappen waarvoor ik de rechten niet heb!! Zodra de code er een tegenkomt, crasht deze volledig.
