Wyszukiwanie podfolderów za pomocą wbudowanej funkcji Dir

Wbudowana funkcja Dir nie dawała sobie rady z pobraniem nazw podfolderów Po wywołaniu funkcji ListSubFolders() korzystającej z funkcji Dir MS Access zgłosił błąd i pokazał tylko 3 znalezione foldery:

Błąd wykonania powodował plik, a właściwie jego nazwa w formacie Unicode Ola作手ma册kota.txt, z którą to funkcja Dir nie dawała sobie rady.

Komenda (polecenie) DIR uruchamiana za pomocą funkcji Shell(...)

Ani lista podfolderów zwracana przez komendę Dir, uzyskana po uruchomieniu w oknie „Immediate” poniższej instrukcji:

?Shell(Environ$("COMSPEC") & " /k Dir C:\MyFiles\* /A:D /B /S",vbMaximizedFocus)

ani lista podfolderów uzyskana po przekierowaniu zwracanego strumienia do pliku tekstowego ~Dir2File.txt nie zawiera prawidłowych nazw podfolderów.

Otrzymany plik z tekstowy o stronie kodowej IBM-852, (po przekonwertowaniu na stronę kodową 1250) zawierał identyczny tekst zwrócony w oknie poleceń.

Lista podfolderów zwracanych przez FileSystemObject (FSO)

Skoro ani funkcja Dir ani komenda Dir nie daje sobie rady z pobraniem nazw podfolderów w folderze roboczym, spróbujemy uzyskać listę podfolderów w folderze roboczym wykorzystując usługę Windows Script Host (WSH) i jej obiekt FileSystemObject, który zapewnia dostęp do systemu plików komputera. FileSystemObject zawiera metody i właściwości pozwalającymi zarządzać dyskami, folderami i plikami. Umożliwia ich tworzenie, usuwanie oraz uzyskiwanie informacji o folderach i plikach.

Obiekt FileSystemObject zawiera poniższe obiekty:

Obiekt Drive

zapewnia dostęp do właściwości konkretnego dysku twardego lub udziału sieciowego

Obiekt File

Zapewnia dostęp do wszystkich właściwości pliku i kolekcji plików

Obiekt Folder

Zapewnia dostęp do wszystkich właściwości folderu i kolekcji folderów

Obiekt TextStream

Ułatwia sekwencyjny dostęp do pliku tj. odczyt, zapis i dodawanie tekstu do pliku

oraz metody

Obiekt Folder

Wykorzystamy taże obiekt Folder który zawiera poniższe metody

oraz właściwości

Aby uzyskać listę podfolderów w folderze roboczym wykorzystamy dwie metody obiektu FileSystemObject

obiekt.FolderExists(ścieżka)

która zwraca jest wartość logiczna informującą, czy istnieje katalog określony przez podaną ścieżkę

obiekt.GetFolder(ścieżka)

która zwraca egzemplarz obiektu Folder reprezentujący katalog określony przez podaną ścieżkę

oraz metodę obiektu Folder

obiekt.SubFolders

zwraca kolekcję podfolderów znajdujących się w określonym folderze, także podfoldery z atrybutami ukryty i systemowy.

obiekt.Path

która zwraca ścieżkę do wyszczególnionego obiektu

Poniżej przedstawiam rekurencyjną funkcję fileListSubFoldersFSO(...) As Long wykorzystującą usługę Windows Script Host (WSH) i jej obiekt FileSystemObject w celu znalezione wszystkich podfolderów w folderze roboczym oraz sposób jej wywołania wraz z zapisem uzyskanej listy podfolderów do tabeli i pliku tekstowego.

⊗ Funkcja fileListSubFoldersFSO( _
           oFolder As String, _
           colSubFoldersRet As Collection) As Long

Public Function fileListSubFoldersFSO(oFolder As Object, _
                                  colSubFoldersRet As Collection) As Long
Dim subFolder As Object

  ' przeszukaj folder roboczy
  For Each subFolder In oFolder.SubFolders
    colSubFoldersRet.Add subFolder.Path & "\"
    Call fileListSubFoldersFSO(subFolder, colSubFoldersRet)
  Next

  fileListSubFoldersFSO = colSubFoldersRet.Count

End Function

Poniżej przykładowe wywołanie rekurencyjnej funkcji fileListSubFoldersFSO(...) i zapis zwróconych ścieżek podfolderów z folderu głównego do pliku tekstowego "~SubFoldersFSO.txt" oraz do tabeli "tblSubFoldersFSO" w bieżącej bazie MS Access.

Private Sub btnListFoldersFSO_Click()
 
Dim colSubFolders   As Collection
Dim oFSO            As Object
Dim oIniFolder      As Object
Dim sFolderName     As String
Dim vFolder         As Variant
Dim ff              As Integer
Dim lCountSF        As Long
Const conFolderPath As String = "C:\MyFiles\"
Const conFileOut    As String = "C:\MyFiles\~SubFoldersFSO.txt"
 
Dim dbs             As DAO.Database
Dim rst             As DAO.Recordset
Const conTblName    As String = "tblSubFoldersFSO"
Const conFldName    As String = "SubFolderNameFSO"
 
  Set colSubFolders = New Collection
  Set oFSO = CreateObject("Scripting.FileSystemObject")
     
    ' sprawdź, czy istnieje folder roboczy conFolderPath
    If Not oFSO.FolderExists(conFolderPath) Then
      MsgBox "Brak folderu " & conFolderPath & " w podanej lokalizacji!"
      Set oFSO = Nothing
      Exit Sub
    End If
     
    Set oIniFolder = oFSO.GetFolder(conFolderPath)
      ' pobierz wszystkie podfoldery
      lCountSF = fileListSubFoldersFSO(oIniFolder, colSubFolders)
    Set oIniFolder = Nothing
 
    ' folder roboczy conFolderPath nie zawiera podfolderów
    If lCountSF = 0 Then
      MsgBox "Brak podfolderów w folderze roboczym:" & vbNewLine & _
              conFolderPath, vbInformation
      Exit Sub
    End If
       
    ' kolekcja zawiera podfoldery, zapisz poszczególne elementy do pliku
      ff = FreeFile
      Open conFileOut For Binary Access Write As #ff
        For Each vFolder In colSubFolders
          sFolderName = StrConv(vFolder & vbNewLine, vbUnicode)
          Put #ff, , sFolderName
        Next
      Close #ff
 
  ' kolekcja zawiera podfoldery, zapisz poszczególne elementy w tabeli
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(conTblName, dbOpenDynaset, dbAppendOnly)
       
      For Each vFolder In colSubFolders
        rst.AddNew
          rst.Fields(conFldName) = vFolder
          Debug.Print vFolder
        rst.Update
      Next
 
      rst.Close
    Set rst = Nothing
    Set dbs = Nothing
   
  Set colSubFolders = Nothing
  Set oFSO = Nothing
 
End Sub