Hướng dẫn: Chạy thủ tục GetDirTrees
Sub GetDirTrees() Dim objFso As FileSystemObject Dim fileExplorer As FileDialog Dim strRootFolder As String ' Count of folder Dim intFolder As Integer ' Count of file Dim intFile As Integer Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker) ' Cho phép chọn một hoặc nhiều folder ' fileExplorer.AllowMultiSelect = False With fileExplorer If .Show = -1 Then strRootFolder = .SelectedItems.Item(1) Else MsgBox "Bạn chưa chọn folder", , "AZ Edu" ' Khi chưa chọn folder biến strRootFolder mặc định là vbNullString End If End With Set fileExplorer = Nothing If strRootFolder = "" Then Exit Sub Set objFso = New FileSystemObject Call GetDir(objFso.GetFolder(strRootFolder), 0, 0, intFolder, intFile) Set objFso = Nothing End Sub
Lưu ý: Cần Add thêm Windows Scrip Host Object Model để sử dụng cho objFso
Thủ tục GetDir
Private g_intMaxCol As Integer Private Sub GetDir(ByVal objFolder As Folder, _ ByRef intRow As Integer, _ ByVal intCol As Integer, _ ByRef intFolder As Integer, _ ByRef intFile As Integer) Dim obbjSubFilder As Folder Dim objFile As File Dim intCol2 As Integer intFolder = intFolder + 1 intRow = intRow + 1 intCol2 = 1 intCol = intCol + 1 Cells(intRow, intCol).Value = "[" & objFolder.Name & "]" If g_intMaxCol < intCol Then g_intMaxCol = intCol For Each objSubFolder In objFolder.SubFolders Call GetDir(objSubFolder, intRow, intCol, intFolder, intFile) Next ' objSubFolder intCol2 = intCol intCol = intCol + 1 intFile2 = intFile For Each objFile In objFolder.Files intFile = intFile + 1 intRow = intRow + 1 intCol3 = 1 Do While intCol3 < intCol2 intCol3 = intCol3 + 1 Loop With objFile Cells(intRow, intCol).Value = .Name End With Next ' objFile Set objFolder = Nothing End Sub
Code đã được giản lược từ https://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_080.html
Download file GetDirTrees.xlsm
Đăng ký ngay Khóa học VBA Cơ bản đến Nâng cao để Ứng dụng hiệu quả Macro & VBA trong nâng cao hiệu xuất công việc