Próbuję znaleźć "ścieżkę" folderu o podanej nazwie, aby zautomatyzować rzeczy w naszym biurze projektowym za pomocą solidworks.
Zaznaczam, że mam tylko nazwę pliku, a nie jego ścieżkę.
powinno to wyglądać mniej więcej tak: F:\Business\??? \NazwaFolderu\...
Tylko na razie mogę się dowiedzieć, czy istnieje, ale nie po to, by odzyskać swoją ścieżkę, której potrzebuję na przyszłość. Mam tylko informację zwrotną "mam to" w konsoli
Macie jakieś pomysły?
Oto mój kod:
Funkcja FindFolder()
Dim searchFolderName As Ciąg searchFolderName = "F:\Oferty"
Dim FileSystem jako obiekt
Set FileSystem = CreateObject("Scripting.FileSystemObject")
Sub doFolder(Folder) Dim subFolder W przypadku błędu Wznów następny Dla każdego podfolderu w folderze Folder.SubFolders Jeśli subFolder.Name jak "NazwaFolderu", a następnie Debug.Print subFolder.Name, subFolder.GetPath Debug.Print ("rozumiem") Koniec Zakończ jeżeli:
Czy są włączone poświadczenia środowiska uruchomieniowego skryptów firmy Microsoft?
Ten kod działa dla mnie bardzo dobrze:
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
Całość jest wrażliwa na pękanie, więc należy zachować ostrożność. Jeśli i tak przejdzie przez Got It, to dlatego, że Jeśli działa, więc błąd jest gdzie indziej.
Korzystając z funkcji tego typu, trzeba pomyśleć o opróżnieniu pamięci. Spróbuję ustawić FileSystem = nothing:Set Subfolder = Nothing tuż przed końcem, który jest w sekcji "Rozumiem"
Wygląda jednak na to, że miałeś rację, kiedy uruchamiam kod dla pierwszych folderów, działa on idealnie. Ale nie na kolejne... Trzeba powiedzieć, że serwer jest załadowany.
Może spróbuj suba wyjściowego zamiast End. Następnie umieść Set FileSystem = Nothing w głównej procedurze w zasadzie:
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
Najnowsza wersja kodu działa poprawnie. Aż do momentu, w którym szukasz folderu znajdującego się bardzo daleko w drzewie... Jeśli podczas wyszukiwania natkniesz się na folder systemowy (taki jak Informacje o woluminie systemowym), procedura wyszukiwania zbacza z torów: zwraca niezdefiniowane podfoldery bez nazw, ale zwraca wartość "True" podczas testowania zgodności z nazwą wyszukiwania. Stąd pusty ciąg i fałszywy wynik. Atrybuty nadrzędnego folderu systemowego nie wskazują na konkretny status: wartość 22, czyli katalog, ukryty i systemowy, nic niezwykłego. Zauważ, że są to te same atrybuty, co dla katalogu głównego dysku ("D:\"), co nie stanowi problemu.
Aby obejść pb, nie znalazłem innego rozwiązania, jak tylko przetestować liczbę podfolderów (nb = Folder.SubFolders.Count) przed pętlą wyszukiwania i zakończyć procedurę, jeśli spowoduje to błąd (70). W oryginalnym kodzie wznawianie w przypadku błędu wznawiania następnego ukrywa błąd.
Dodałem również wartość logiczną, która pozwala zatrzymać wyszukiwanie po znalezieniu folderu. Przetestuj, który będzie musiał zostać usunięty, jeśli w wyszukiwaniu może znajdować się kilka folderów o tej samej nazwie...
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
Przydatne może być sprawdzenie liczby znaków w łańcuchu ścieżek, aby dowiedzieć się, czy to limit długości ścieżki ciągu jest problemem, czy coś zupełnie innego.
Kolejna rzecz do wypróbowania; Zezwalaj systemowi Windows na obsługę dłuższych ścieżek:
W edytorze rejestru przejdź do HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\FileSystem\LongPathsEnabled , zmień jego wartość na 1 i uruchom ponownie.
Ryzyko przepełnienia stosu wykonawczego VBA jest aspektem, który należy wziąć pod uwagę w przypadku procedury rekurencyjnej, takiej jak doFolder makra. O ile się nie mylę, w tym przypadku wyszukiwania folderu na dysku liczba jednoczesnych połączeń jest co najwyżej równa liczbie folderów o najdłuższej ścieżce istniejącej w drzewie katalogów. To znaczy kilka jednostek, a nawet kilkadziesiąt, prawdopodobnie nie więcej. W każdym razie jest mało prawdopodobne, aby spowodowało to przepełnienie, przepełnienie, które byłoby sygnalizowane przez błąd.
Mówiąc o błędach: podczas opracowywania makra instrukcja On Error Resume Next musi zostać usunięta , co skutkuje ukryciem błędów poprzez ciche kontynuowanie wykonywania w wierszu następującym po błędzie. Możesz to sprawdzić już w pierwszej wersji makra: wystąpił błąd (70: odmowa uprawnień), a spojrzenie na właściwość Folder.path w tym momencie daje winowajcę: Informacje o woluminie systemowym.
Jeśli problem na twoim serwerze jest tego samego rodzaju, co na dysku C:, tj. folderze, który nie jest dostępny, być może dzięki temu prostemu sposobowi będziesz w stanie go zidentyfikować, pozwalając na wystąpienie błędu w czasie wykonywania...
Jeśli chodzi o prowadzenie badań tylko nad częścią nazwy, nie wydaje mi się, aby przynosiło to znaczące korzyści. Może to być poprawa szybkości przetwarzania, gdy makro będzie działać we wszystkich przypadkach.
Panie BLT, rzeczywiście wydaje się to logiczne. Nie mam instrukcji On Error Resume Next , ponieważ używam kodu, który opublikowałeś powyżej.
Niestety, nie mogę pobrać folderu , który powoduje problem, ponieważ VBA ulega całkowitej awarii podczas uruchamiania na F:\, gdy przekraczam pierwsze 4 lub 5 folderów...
Jeśli chodzi o filtrowanie według litery, inna opcja: ograniczyć wyszukiwanie do pierwszego podfolderu? Nie muszę iść dalej i uniemożliwiłoby mi to natknięcie się na foldery z odmową uprawnień? Jeśli chodzi o F:\Business, którego szukam, zwykle mam do tego wszelkie prawa.
Sylk, zamierzam zmienić klucz rejestru i spróbować ponownie.
Panie BLT, po kilku próbach w końcu udaje mi się uzyskać informację zwrotną w terminalu! Rzeczywiście, są foldery systemowe lub foldery, do których nie mam praw!! Gdy tylko kod napotka jeden, ulega całkowitemu awarii.
