Lấy danh sách đường dẫn File và thư mục trong VBA

HeSanbi

Thành viên gắn bó
Tham gia ngày
24 Tháng hai 2013
Bài viết
1,699
Được thích
2,045
Điểm
1,368
Hai hàm dưới đây sẽ giúp chúng ta thực hiện lấy tất cả File hoặc Path trong một thư mục hoặc file và các thư mục bên trong thư mục.

Hàm ListAllFiles và các tham số:
1. aFolder- Đối số là chuỗi hoặc mảng: Là Path của Folder cần lấy List File
2. FSO - Đối số Object: Truyền vào Object để giải phóng về sau.
3. Files - Đối số trả ngược lại Variant : Trả lại List File
4. IncludeSubfolders - Đối số True/False: Tìm trong tập hợp Folder Con
5. Types - Đối số là chuỗi hoặc mảng: Tìm Type cần lấy, ví dụ: "*.pdf" hoặc Array(".pdf", ".xlsb", ....)
6. NameTypes - Đối số là chuỗi hoặc mảng: Tìm Name Type cần lấy, ví dụ: "WinRAR archive" hoặc Array("WinRAR archive", "JSON File", ....)
.......................................................
Capture.JPG
....................................................
7. iShortPart - Đối số True/False: Path trả lại là một Part đã rút gọn.


Hàm ListAllFolder và các tham số:

1. aFolder- Đối số là chuỗi hoặc mảng: Là Path của Folder cần lấy List File
2. FSO - Đối số Object: Truyền vào Object để giải phóng về sau.
3. Folders- Đối số trả ngược lại Variant : Trả lại List Folder
4. IncludeSubfolders - Đối số True/False: Tìm trong tập hợp Folder Con

------------------------------
JavaScript:
Option Explicit
'Sửa EarlyBinding = True Nếu đã thêm thư viện trong Tools - Tăng hiệu năng hoặc nhà phát triển'
#Const EarlyBinding = False
Private Sub test_ListAllFiles()
  Dim Item, Files, P As String
  P = "D:\Path\"
  Call ListAllFiles(P, , Files, True, ".xlsb")
  For Each Item In Files: Debug.Print Item: Next
End Sub

Private Sub test_ListAllFiles2()
  TestPath 1
  'TestPath 2
  'TestPath "D:\Files"
End Sub
Sub TestPath(Optional ByRef Path As String, _
                       Optional ByVal inSubfolders As Boolean)

  Dim Temp As String, Files As Variant, Ext As String

  #If EarlyBinding Then
    Dim FSO  As Scripting.FileSystemObject
  #Else
    Dim FSO As Object
  #End If
  If Path = vbNullString Then
    Temp = IIf(Environ("Tmp") <> "", Environ("Tmp"), Environ("Temp")) & "\"
  Else
    Temp = Path & IIf(Right(Path, 1) <> "\", "\", "")
  End If
  Select Case CStr(Path)
    Case "2": Files = DialogExplorer
    Case Else:
      If CStr(Path) = "1" Then Path = DialogExplorer(FileDialog:=4)
      GoSub GetFiles
  End Select
  If Not IsArray(Files) Then Exit Sub
  Dim Item
  For Each Item In Files: Debug.Print Item: Next

  Set FSO = Nothing
  Exit Sub

GetFiles:
  ListAllFiles Path, FSO, Files, inSubfolders, ".pdf", , False
Return
End Sub

Sub ListAllFiles(ByVal Paths, _
        Optional ByRef FSO As Object, _
        Optional ByRef Files As Variant, _
        Optional ByVal IncludeSubfolders As Boolean = False, _
        Optional ByVal Types = "*.*", _
        Optional ByVal NameTypes = "", _
        Optional ByVal iShortPart As Boolean = False, _
        Optional ByVal HasDel As Boolean = False)

  If VBA.TypeName(Paths) = "String" Then Paths = Array(Paths)
  Dim I&, k&, T$, T2$
  Dim aTypes(), Arr(), dArr()
  Dim SF, Item, Folder, oFolder
  I = -1
  If VBA.TypeName(NameTypes) = "String" Then
    If NameTypes <> vbNullString Then ReDim aTypes(0): aTypes(0) = VBA.LCase(NameTypes)
  Else
    ReDim aTypes(UBound(NameTypes))
    For I = LBound(NameTypes) To UBound(NameTypes): aTypes(I) = VBA.LCase(NameTypes(I)): Next I
  End If
  If VBA.TypeName(Types) = "String" Then
    ReDim aTypes(I + 1)
    aTypes(I + 1) = "*" & VBA.LCase(Types)
  Else
    ReDim aTypes(UBound(Types) + VBA.IIf(I = -1, 0, I))
    For k = LBound(Types) To UBound(Types): aTypes(k + VBA.IIf(I = -1, 0, I)) = "*" & VBA.LCase(Types(k)): Next k
  End If
  If FSO Is Nothing Then Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
  I = 0
  If VBA.IsArray(Files) Then
    ReDim Arr(1 To UBound(Files) - LBound(Files) + 1)
    For I = LBound(Files) To UBound(Files) - LBound(Files) + 1: Arr(I) = Files(I): Next I
    I = I - 1
  End If
  k = 0
  For Each Folder In Paths
    If FSO.FolderExists(Folder) Then
      Set oFolder = FSO.GetFolder(Folder)
      For Each Item In oFolder.Files
        T = vbNullString: T = VBA.LCase(Item.Name)
        T2 = vbNullString: T2 = VBA.LCase(Item.Type)
        For Each SF In aTypes
          If VBA.Left(T, 1) <> "~" And (T Like SF Or T2 = SF) Then
            I = I + 1: ReDim Preserve Arr(1 To I)
            Arr(I) = VBA.IIf(iShortPart, Item.ShortPath, Item.Path)
            Exit For
          End If
        Next SF
      Next Item
      If IncludeSubfolders Then
        For Each SF In oFolder.SubFolders
          k = k + 1: ReDim Preserve dArr(1 To k): dArr(k) = SF.Path
        Next SF
      End If
    End If
  Next Folder
  If I > 0 Then Files = Arr
  If IncludeSubfolders And k > 0 Then
    ListAllFiles dArr, FSO, Files, True, Types, NameTypes, iShortPart, HasDel
  End If
End Sub
Private Sub test_ListAllFolder()
  On Error Resume Next
  Dim Item, I&, Arr(0), UB, Fs
  Dim P$: P = "D:\Sounds\CayBoDe\" 'ActiveSheet.Parent.Path
  Call ListAllFolder(P, , Fs)
  For Each Item In Fs: Debug.Print Item: Next Item
End Sub

Sub ListAllFolder(ByVal Paths, _
        Optional ByRef FSO As Object, _
        Optional ByRef Folders As Variant, _
        Optional ByVal iShortPart As Boolean, _
        Optional ByVal HasDel As Boolean)
  If VBA.TypeName(Paths) = "String" Then Paths = Array(Paths)
  Dim I&, k&, LB%, UB&, Arr(), dArr(), Folder
  Dim Item As Scripting.Folder
  Dim oFolder As Scripting.Folder
  If FSO Is Nothing Then Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
  If VBA.IsArray(Folders) Then
    LB = LBound(Folders): UB = UBound(Folders)
    ReDim Arr(1 To UB - LB + 1)
    For I = 1 To UB - LB + 1: Arr(I) = Folders(I): Next I
    I = I - 1
  End If
  For Each Folder In Paths
    If FSO.FolderExists(Folder) Then
      Set oFolder = FSO.GetFolder(Folder)
      For Each Item In oFolder.SubFolders
        k = k + 1: ReDim Preserve dArr(1 To k)
        dArr(k) = VBA.IIf(iShortPart, Item.ShortPath, Item.Path)
        I = I + 1: ReDim Preserve Arr(1 To I): Arr(I) = dArr(k)
      Next Item
    End If
  Next Folder
  Folders = Arr
  ListAllFolder dArr, FSO, Folders, iShortPart, HasDel
End Sub

Function DialogExplorer(Optional FolderPath As String, _
                        Optional sDesc As String = "All File", _
                        Optional sFilter As String = "*.*", _
                        Optional Title As String = "File Open", _
                        Optional FileDialog As Long = 1, _
                        Optional InitialView As Long = 2, _
                        Optional ButtonName As String = "&Select", _
                        Optional MultiSelect As Boolean = -1) As Variant
  DialogExplorer = 0
  Dim Arr(), K, it
  With Application.FileDialog(FileDialog) '1|4'
    If ButtonName <> vbNullString Then .ButtonName = ButtonName
    If FolderPath <> vbNullString Then
      .InitialFileName = FolderPath
    Else
      .InitialFileName = Application.DefaultFilePath
    End If
    If FileDialog = 1 Then
      .Filters.Clear
      .Filters.Add sDesc, sFilter
      If sDesc <> "All File" Then .Filters.Add "All File", "*.*"
    End If
    If Title <> vbNullString Then .Title = Title
    .InitialView = InitialView 'msoFileDialogViewDetails'
    .AllowMultiSelect = IIf(FileDialog = 4, False, MultiSelect)
    If .Show Then
      If FileDialog = 4 Then
        DialogExplorer = .SelectedItems(1)
      Else
        For Each it In .SelectedItems
          ReDim Preserve Arr(K): Arr(K) = it: K = K + 1
        Next it
        DialogExplorer = Arr
      End If
    End If
    If FileDialog = 1 Then .Filters.Clear
  End With
End Function

--------------------
Tag: đường dẫn file, đường dẫn thư mục, đường dẫn tệp, trong thư mục, trong folder


File ứng dụng:
 

File đính kèm

  • Manager_Explorer.xlsm
    163 KB · Đọc: 27
Lần chỉnh sửa cuối:

vanaccex

Thành viên tiêu biểu
Tham gia ngày
8 Tháng bảy 2018
Bài viết
419
Được thích
269
Điểm
218
Hi anh ! Với chủ đề này anh có thể mở rộng chủ đề này đối với File excel có thể lấy đến tên Sheet được không ạ !
 

vanaccex

Thành viên tiêu biểu
Tham gia ngày
8 Tháng bảy 2018
Bài viết
419
Được thích
269
Điểm
218
Không hiểu ý của bạn muốn hỏi.
Dạ Em Vân gửi Thông tin kết quả cần lấy trong FileQuanLy gồm các vấn đề :
1. Lấy đường dẫn File
2. Lấy thông tin Sheet Trong File
3. Có thể thay tên hoặc xóa sheet trong File
 

File đính kèm

  • QuanLyFile.rar
    28.1 KB · Đọc: 43

HeSanbi

Thành viên gắn bó
Tham gia ngày
24 Tháng hai 2013
Bài viết
1,699
Được thích
2,045
Điểm
1,368
Dạ Em Vân gửi Thông tin kết quả cần lấy trong FileQuanLy gồm các vấn đề :
1. Lấy đường dẫn File
2. Lấy thông tin Sheet Trong File
3. Có thể thay tên hoặc xóa sheet trong File
Bạn nên đăng bài mới để nhận sự trợ giúp phù hợp
 

HeSanbi

Thành viên gắn bó
Tham gia ngày
24 Tháng hai 2013
Bài viết
1,699
Được thích
2,045
Điểm
1,368
Dạ Em Vân gửi Thông tin kết quả cần lấy trong FileQuanLy gồm các vấn đề :
1. Lấy đường dẫn File
2. Lấy thông tin Sheet Trong File
3. Có thể thay tên hoặc xóa sheet trong File

Tôi thấy cũng đơn giản nên viết code cho bạn
 

Thanh Bình PV

Thành viên hoạt động
Tham gia ngày
30 Tháng mười 2019
Bài viết
149
Được thích
19
Điểm
118
Tuổi
24
Cải tiến Code và Ứng dụng quản lý và đổi tên file đơn giản dựa trên cơ sở Code ở trên.
-------------------------
File chạy rất tốt ạ. Mà anh có thể chỉnh giúp em để tên File không hiện đuôi File không ạ. Và có thể thêm cột Size và Length của File không ạ.
Em cảm ơn ạ.
 
Lần chỉnh sửa cuối:

HeSanbi

Thành viên gắn bó
Tham gia ngày
24 Tháng hai 2013
Bài viết
1,699
Được thích
2,045
Điểm
1,368
File chạy rất tốt ạ. Mà anh có thể chỉnh giúp em để tên File không hiện đuôi File không ạ. Và có thể thêm cột Size và Length của File không ạ.
Em cảm ơn ạ.
---------------


Bạn có thể tải lại file trên, đọc hướng dẫn và sử dụng
 

duykhanhknhc

Thành viên mới
Tham gia ngày
27 Tháng chín 2014
Bài viết
7
Được thích
0
Điểm
301
sao mình chạy báo lỗi. anh em nào biết khắc phục không ạ
 

File đính kèm

  • Screenshot (16).png
    Screenshot (16).png
    124 KB · Đọc: 42

ntlong1210

Thành viên mới
Tham gia ngày
15 Tháng mười hai 2010
Bài viết
4
Được thích
0
Điểm
0
Tuổi
40
Cập nhật sửa lỗi File ví dụ:


----------------------------
Bạn ơi có thể thêm cột thể hiện Ngày tạo file (Created) và cột Ngày chỉnh sửa cuối cùng (Date Modified) nữa giúp mình với được không?
Và cho mình hỏi có thể tạo được luôn HyperLink để mở file trực tiếp không?
Cảm ơn bạn rất nhiều
 

HeSanbi

Thành viên gắn bó
Tham gia ngày
24 Tháng hai 2013
Bài viết
1,699
Được thích
2,045
Điểm
1,368
@duykhanhknhc
Bạn tìm đến đường dẫn Microsoft Share/VBA/VBA6
Đổi tên VBE6EXT.OLB chuyển thành VBE6EXT.OLD xem sao.

@ntlong1210 Bạn có thể sử dụng file Cập nhật bên dưới.


-----------------------------
Tải tệp #1
 
Lần chỉnh sửa cuối:

ntlong1210

Thành viên mới
Tham gia ngày
15 Tháng mười hai 2010
Bài viết
4
Được thích
0
Điểm
0
Tuổi
40
@ntlong1210 Bạn có thể sử dụng file Cập nhật bên dưới.


-----------------------------

Trước hết một lần nữa cảm ơn bạn vì sự giúp đỡ nhiệt tình. Tiếp tục mong bạn giúp mình cải tiến tiếp để thuận tiện cho nhu cầu công việc với các nội dung như sau:
- Bỏ cột Length và cột Kiểu mở rộng
- Thêm các cột tên thư mục chứa file, tên thư mục chứa thư mục chứa file (giúp mình 3 hoặc 4 cấp thư mục trở lên từ thư mục chứa file)
- Bổ sung thêm một chức năng gồm:
+ Gộp toàn bộ các sheet của toàn bộ các file trong list vào 1 file mới
+ Tách toàn bộ các sheet của 1 được lựa chọn trong list ra các file mới, tên file mới theo tên Sheet sẵn có của file đó
+ Gộp nội dung tất cả các sheet (cùng cấu trúc) trong 1 file lựa chọn vào 1 sheet mới trong cùng file đó)
Mẫu ví dụ các Menu và tên cột như trong file mình đính kèm.
Trân trọng cảm ơn bạn.
 

File đính kèm

  • Copy of QuanLyFile-1.xlsm
    98 KB · Đọc: 27

HeSanbi

Thành viên gắn bó
Tham gia ngày
24 Tháng hai 2013
Bài viết
1,699
Được thích
2,045
Điểm
1,368
Trước hết một lần nữa cảm ơn bạn vì sự giúp đỡ nhiệt tình. Tiếp tục mong bạn giúp mình cải tiến tiếp để thuận tiện cho nhu cầu công việc với các nội dung như sau:
- Bỏ cột Length và cột Kiểu mở rộng
- Thêm các cột tên thư mục chứa file, tên thư mục chứa thư mục chứa file (giúp mình 3 hoặc 4 cấp thư mục trở lên từ thư mục chứa file)
- Bổ sung thêm một chức năng gồm:
+ Gộp toàn bộ các sheet của toàn bộ các file trong list vào 1 file mới
+ Tách toàn bộ các sheet của 1 được lựa chọn trong list ra các file mới, tên file mới theo tên Sheet sẵn có của file đó
+ Gộp nội dung tất cả các sheet (cùng cấu trúc) trong 1 file lựa chọn vào 1 sheet mới trong cùng file đó)
Mẫu ví dụ các Menu và tên cột như trong file mình đính kèm.
Trân trọng cảm ơn bạn.
--------------------------------------

Những yêu cầu của bác tôi không hỗ trợ được, bác có thể chờ sự trợ giúp của diễn đàn.
 

Thanh Bình PV

Thành viên hoạt động
Tham gia ngày
30 Tháng mười 2019
Bài viết
149
Được thích
19
Điểm
118
Tuổi
24
Cập nhật sửa lỗi File ví dụ:
Anh ơi,
Anh cập nhật thêm vấn đề này được không ạ.
Em muốn di chuyển nhiều file (100 file) nhưng không di chuyển toàn bộ. Em thử chọn 100 file đó và nhấn di chuyển thì chỉ có thể di chuyển 1 file thôi.
Mong anh cập nhật tính năng chọn nhiều file rồi nhấn di chuyển để chuyển toàn bộ file đã chọn ạ.
Em cảm ơn.
 

MinhKhai

Giải pháp Ếc-xào
Tham gia ngày
16 Tháng tư 2008
Bài viết
877
Được thích
543
Điểm
868
Cập nhật sửa lỗi File ví dụ:


----------------------------
File của bạn chạy tốt đấy.
Tuy nhiên, nếu tạo thêm Hyperlink vào tên file nữa thì tốt.
Ngoài ra cách viết code của bạn thật tổng quát, nhưng thành ra hơi khó hiểu với 1 người mới làm quen VBA
 
Top Bottom