Tìm các file có tên file giống với chuỗi trong các foldẻ

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

hadoan-pap

Thành viên tiêu biểu
Tham gia
8/7/15
Bài viết
455
Được thích
18
Kính gửi mọi người ạ.

Em muốn tìm toàn bộ các file nằm trong toàn bộ các folder nhỏ theo 1 đường dẫn chỉ định ạ.

Ví dụ: em gõ file name cần tìm kiếm "Invoice", đường dẫn cần tìm "D:\Main Files\Invoice"... Thì nó sẽ tìm toàn bộ trong các folder nhỏ bên trong , những file nào có tên file mà có chữ "Invoice" (Ví dụ : Invoice_xxxx, Abc_invoice...) thì nó sẽ ghi ra bảng excel như đính kèm ạ (Sheet "kết quả")

Vì có rất nhiều file và folder nhỏ nằm trong folder lớn, nên em rất mong được giúp đỡ đoạn code nào tối ưu nhất ạ.

Em xin chân thành cảm ơn!
 

File đính kèm

  • Find file.xlsm
    17.1 KB · Đọc: 6
Cái này dùng PowerShell, viết vào csv!
 
Upvote 0
Vì có rất nhiều file và folder nhỏ nằm trong folder lớn, nên em rất mong được giúp đỡ đoạn code nào tối ưu nhất ạ.
Bạn tham khảo code dùng tạm cho đến khi tìm được cái tối ưu.
PHP:
Sub Button1_Click()
    ListFiles
End Sub
Sub ListFiles()
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim subfolder As Object
    Dim searchString As String
    Dim folderPath As String
    Dim ws As Worksheet
    Dim i As Long
    
    searchString = Sheets("Sheet1").Range("E2").Value
    folderPath = Sheets("Sheet1").Range("F2").Value

    Set ws = Sheets("Ketqua")
    lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    'ws.Cells.ClearContents ' Clear previous results

    ' Create FSO object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    If lastRow < 2 Then lastRow = 2
    i = lastRow

    Call ListFilesInFolder(fso.GetFolder(folderPath), searchString, ws, i)
    
    ' Clean up
    Set fso = Nothing
End Sub

Sub ListFilesInFolder(folder As Object, searchString As String, ws As Worksheet, ByRef i As Long)
    Dim file As Object
    Dim subfolder As Object

    ' Loop file
    For Each file In folder.Files
        If InStr(1, file.Name, searchString, vbTextCompare) > 0 Then
            ws.Cells(i, 1).Value = file.Name
            ws.Cells(i, 2).Value = file.Path
            i = i + 1
        End If
    Next file

    ' Loop folder
    For Each subfolder In folder.SubFolders
        Call ListFilesInFolder(subfolder, searchString, ws, i)
    Next subfolder
End Sub
 

File đính kèm

  • Find file.xlsm
    20.1 KB · Đọc: 3
Upvote 0
Bạn tham khảo code dùng tạm cho đến khi tìm được cái tối ưu.
PHP:
Sub Button1_Click()
    ListFiles
End Sub
Sub ListFiles()
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim subfolder As Object
    Dim searchString As String
    Dim folderPath As String
    Dim ws As Worksheet
    Dim i As Long
   
    searchString = Sheets("Sheet1").Range("E2").Value
    folderPath = Sheets("Sheet1").Range("F2").Value

    Set ws = Sheets("Ketqua")
    lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    'ws.Cells.ClearContents ' Clear previous results

    ' Create FSO object
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    If lastRow < 2 Then lastRow = 2
    i = lastRow

    Call ListFilesInFolder(fso.GetFolder(folderPath), searchString, ws, i)
   
    ' Clean up
    Set fso = Nothing
End Sub

Sub ListFilesInFolder(folder As Object, searchString As String, ws As Worksheet, ByRef i As Long)
    Dim file As Object
    Dim subfolder As Object

    ' Loop file
    For Each file In folder.Files
        If InStr(1, file.Name, searchString, vbTextCompare) > 0 Then
            ws.Cells(i, 1).Value = file.Name
            ws.Cells(i, 2).Value = file.Path
            i = i + 1
        End If
    Next file

    ' Loop folder
    For Each subfolder In folder.SubFolders
        Call ListFilesInFolder(subfolder, searchString, ws, i)
    Next subfolder
End Sub
Em xin cảm ơn nhiều ạ!
 
Upvote 0
Các bác cứ bắt viết tiếng Việt có dấu đầy đủ. Nhiều khi nó gây hoang mang cho người đọc, ví dụ như foldẻ nghĩa là gì? Có lẽ không nên cứng nhắc quá. --=0 --=0 --=0
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom