Access

  MS Access 2010+  |  Przetwarzanie plików  |   VBA 7.0



• Lista podfolderów w folderze roboczym

Na stronie Dir. Lista folderów przedstawiłem wykorzystanie wbudowanej funkcji Dir i komendy Dir w oknie poleceń cmd do uzyskania listy podfolderów w folderze roboczym "C:\MyFiles\", który zawierał podfoldery i pliki o przeróżnych (czasami bardzo dziwnych) nazwach i różnych atrybutach. W sumie folder roboczy zawierał 24 pliki znajdujące się w 8 podfolderach.

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 Wbudowana funkcja Dir Access zgłasił błąd i pokazał tylko 3 znalezione foldery:

Run-time error 52 Dir. Lista podfolderów

Błąd wykonania powodował plik, a właściwie jego nazwa w formacie UnicodeOla作手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.


Lista podfolderów Lista podfolderów  w pliku

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

BuildPath, CopyFile, CopyFolder, CreateFolder, CreateTextFile, DeleteFile, DeleteFolder, DriveExists, FileExists, FolderExists, GetAbsolutePathName, GetBaseName, GetDrive, GetDriveName, GetExtensionName, GetFile, GetFileVersion, GetFileName, GetFolder, GetParentFolderName, GetSpecialFolder, GetStandardStream, GetTempName, MoveFile, MoveFolder, OpenTextFile

Obiekt Folder

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

Copy, Delete, Move, CreateTextFile

oraz właściwości

Attributes, DateCreated, DateLastAccessed, DateLastModified, Drive, Files, IsRootFolder, Name, ParentFolder, Path, ShortName, ShortPath, Size, SubFolders, Type

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
  • Rekurencyjna funkcja fileListSubFoldersFSO (...) wykorzystuje usługę Windows Script Host (WSH) i jej obiekt FileSystemObject w celu znalezione wszystkich podfolderów w folderze roboczym.
  • argumenty:
    • oFolder:
    • argument typu Obiekt wskazująca folder, który zostanie przeszukany w celu znalezienia podfolderów,
    • colSubFoldersRet
    • kolekcja, która przekazywana jest ByRef w kolejnych rekurencyjnych wywołaniach funkcji. W każdym wywołaniu uzapełniana jest ścieżkami znalezionych podfolderów w przekazywanym folderze oFolder:
  • zwraca:
  • Zwraca liczbę znalezionych podfolderów w folderze roboczym oFolder:, a w argumencie ByRef colSubFolders kolekcję, której elementy zawierają pełne ścieżki znalezionych podfolderów ze znakiem "/" (backslash) na końcu ścieżki.
  • autor: Zbigniew Bratko
  • data: 15.11.2017
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
Lista podfolderów. Scripting.FileSystemObject