Viết code tìm kiếm các file trong Folder

Chia sẻ bởi:hands

★★★★★

‹ Cách tìm kiếm nhiều file cùng 1... File áp giá và gán hình, ảnh... ›

Quảng cáo

Chào các Anh
Em có Folder gồm nhiều file mỗi lần tìm kiếm rất lâu
Em muốn viết code như sau
Tại Textbox gõ tên file cần tim
Thì hiện danh sách các file cần tìm trên listbox
chỉ cần nhấn Double click vào thì mở file đó ra
Do upload báo lỗi nên up tạm lên đây
https://www.fshare.vn/file/XDEA70UODJ/

Chào các Anh GPE
Mình muốn sửa Texbox như sau
Chỉ cần gõ tên file thôi không cần gõ *.* ví dụ như
gõ NV-Y104P là tìm kiếm các file thôi
Tại lisbox
1. không hiện đường dẫn chỉ hiện tên file thôi chỉ hiện như vậy thôi
vd:NV-Y104P 9B-1425-004C-pdf
2.Doulbe Click vào listbox vào là mở file luôn không cần đến đường link

Thử file này
Nhấp đúp vào hộp đường dẫn để chọn thư mục
Nhập ký tự đầu của tên file vào hộp tên file
Nhấp đúp vào file trong listbox

www.giaiphapexcel.com/diendan/threads/vi%E1%BA%BFt-code-t%C3%ACm-ki%E1%BA%BFm-c%C3%A1c-file-trong-folder.98173/

Cám ơn Anh Quanghai1969
File này tương tự như file của anh [URL="https://www.giaiphapexcel.com/forum/member.php?61139-ndu96081631"]ndu96081631
ý em lả muốn rút gọn như file đính kèm em đã gửi
hoặc bổ sung thêm vào file 3 checkbox
check chon file Xls
check chon file pdf
check chon tất cả *.*
còn Doulbe Click vào listbox vào là mở file luôn không cần đến đường link

Bạn kiên nhẫn đợi xem coi có ai siêng hơn không nha. Mình lười lắm rồi. Vả lại cũng hết khả năng rồi. Yêu cầu của bạn cao quá với hết tới rồi.
Tính không viết nhưng nhờ tam khảo cái 50% của bạn và code tạm thế này

Chào các Anh GPE
Em thấy file của Anh quanghai1969 rất hay
Nếu trường hợp em muốn sữa tên checkbox trên form ".xls" thành Excel & ".doc" thanh Word ..
Không biết hàm trên đây sữa như thế nào
Function LoaiFile(path) As String
   Dim Tem As String, i As Byte
   With UserForm1
      For i = 1 To 5
         If .Controls("CheckBox" & i) = True Then
            Tem = Tem & path & "*" _
            & .Controls("CheckBox" & i).Caption & "* "
         End If
      Next
      LoaiFile = Tem
   End With
End Function

Sửa thế này thử xem

Function LoaiFile(path) As String
Dim Tem As String, i As Byte, StrType()
StrType = Array(".xls", ".doc", ".pdf", ".zip", ".rar")
For i = 1 To 5
If UserForm1.Controls("CheckBox" & i) = True Then
Tem = Tem & path & "*" & StrType(i – 1) & "*" & Space(1)
End If
Next
LoaiFile = Tem
End Function

Code này đúng với mình đang cần tìm, nhưng file của mình đang lưu trong nhiều thư mục con quá nên nhờ anh giúp thêm phần tìm luôn trong các thư mục con nhé. Cảm ơn nhiều.

Thử dùng File này:
Cách dùng:
– Bước 1: Tại D1, nhấn nút Tạo Link, hộp thoại mở ra tìm và chọn Folder cha xong click OK, vậy là xong việc lấy tên File và tạo Link.
– Bước 2: Chọn cột B và nhấn Ctrl+F, hộp thoại mở ra gõ tên File cần tìm, xong click vào tên File và nhấn Yes.

Cách dùng:
– Bước 1: Tại D1, nhấn nút Tạo Link, hộp thoại mở ra tìm và chọn Folder cha xong click OK, vậy là xong việc lấy tên File và tạo Link.
– Bước 2: Chọn cột B và nhấn Ctrl+F, hộp thoại mở ra gõ tên File cần tìm, xong click vào tên File và nhấn Yes.

1810
Các anh, chị có thể sửa giúp em code này, để nó loại bỏ các thông tin không cần thiết được không ạ!
1. Phần tên thư mục con (chữ xanh da trời trong ảnh) hiện bình thường, không cần hiện trong dấu ngoặc vuông""
2. Tên file tìm được chỉ cần hiện tên thôi, không cần hiện đuôi và thông tin phụ. em cảm ơn ạ!

ví dụ: code hiện tại tìm được file này "I-200714-0005-VCP-CREV QV-Request to approve List of material suppliers.rar (7/24/2020 2:23:10 AM 244,022,305Bytes)"
nhưng em chỉ cần hiện "I-200714-0005-VCP-CREV QV-Request to approve List of material suppliers".
3. Và nếu các cao thủ có thể gán hyperlink cho các thư mục con và các file thì càng tuyệt vời ạ!
Các anh chị check file đính kèm giúp em nhé!
EM VÔ CÙNG CẢM KÍCH!!!

Tôi viết code mới, không dùng code của bạn.

Hướng dẫn:
1. Sub ListFilesAndFolders là code tổng quát dùng để tìm kiếm các thư mục và tập tin. Cùng 1 cách gọi Sub ListFilesAndFolders, tức cùng có một số kết quả như nhau nhưng tùy nhu cầu mà ta có thể trình bầy các kết quả đó theo dạng và trong cấu trúc mà mình mong muốn. Ví dụ cùng tìm thư mục và tập tin trong "C:1" nhưng nếu tôi dùng sub batman1 thì tôi sẽ trình bầy kết quả ở dạng khác, còn bạn sẽ gọi sub buivantinh để trình bầy cũng các kết quả đó nhưng ở dạng khác.
Tóm lại người dùng sẽ gọi Sub ListFilesAndFolders trong code của mình.

2. Mở tập tin Excel -> Alt + F11 -> menu Insert -> Module -> dán code sau vào module vừa thêm.

Với nhu cầu của bạn thì bạn chạy sub buivantinh

Public Sub ListFilesAndFolders(ByVal FolderStart As String, result, Optional fso As Object, Optional ByVal sFilter As String = "", _
        Optional ByVal inSub As Boolean = False, Optional level As Long)
'    kết quả trả về trong mảng result có 3 hàng và nhiều cột - chỉ số hàng và cột tính từ 1.
'    Mỗi cột của mảng result có đường dẫn đầy đủ của tập tin ở hàng  1, ở hàng  2 là level của tập tin ở hàng  1, còn
'    hàng  3 = TRUE (FALSE) ứng với hàng  1 là đường dẫn tới thư mục (tập tin).
'    nếu lấy tất cả các tập tin thì sFilter = "" (đã là mặc định nên có thể bỏ qua)
'    nếu chỉ lấy vd. các tập tin JPG thì sFilter = "*.jpg"
'    nếu lấy các tập tin JPG mà tên phải chứa "hichic" thì nhập sFilter = "*hichic*.jpg"
'    nếu tìm cả trong các thư mục con thì inSub = TRUE, ngược lại thì inSub = False. Mặc định là inSub = False.
'    hàm bắt đầu tìm trong thư mục FolderStart
'    có thể truyền tham số fso và level nhưng không bắt buộc.
Dim count As Long, f As Object, SubF As Object, files As Object
    If fso Is Nothing Then Set fso = CreateObject("Scripting.FileSystemObject")
    If level = 0 Then level = 1
    If fso.FolderExists(FolderStart) Then
        If IsEmpty(result) Then
            ReDim result(1 To 3, 1 To 1)
            count = 0
        Else
            count = UBound(result, 2)
        End If
        count = count + 1
        ReDim Preserve result(1 To 3, 1 To count)
        result(1, count) = FolderStart
        result(2, count) = level
        result(3, count) = True
        level = level + 1

If sFilter = "" Then sFilter = "*"
        Set f = fso.GetFolder(FolderStart)
        On Error Resume Next
        count = f.files.count
        If Err.Number Then
            Err.Clear
            On Error GoTo 0
        Else
            On Error GoTo 0
            Set files = f.files
            For Each SubF In files
                If LCase(SubF.Name) Like LCase(sFilter) Then
                    ReDim Preserve result(1 To 3, 1 To UBound(result, 2) + 1)
                    result(1, UBound(result, 2)) = SubF.Path
                    result(2, UBound(result, 2)) = level
                    result(3, UBound(result, 2)) = False
                End If
            Next SubF
            If inSub Then
                For Each SubF In f.SubFolders
                    ListFilesAndFolders SubF.Path, result, fso, sFilter, True, level
                Next
            End If
        End If

Set f = Nothing
        level = level - 1
    End If
End Sub

'Sub batman1()
'Dim r As Long, level As Long, fso As Object, result, kq()
''    xóa kết quả cũ
'    Sheet1.UsedRange.Clear
''   tất cả các tập tin trong thư mục "c:1" và các thư mục con, chỉ tên thôi.
'    Set fso = CreateObject("Scripting.FileSystemObject")
'    ListFilesAndFolders "c:1", result, , "", True
'    If Not IsEmpty(result) Then
'        ReDim kq(1 To UBound(result, 2), 1 To 1)
'        For r = 1 To UBound(result, 2)
'            level = result(2, r)
'            If UBound(kq, 2) < level Then ReDim Preserve kq(1 To UBound(kq, 1), 1 To level)
'            If r = 1 Then
'                kq(r, level) = result(1, r)
'            Else
'                kq(r, level) = fso.GetBaseName(result(1, r))
'            End If
'        Next r
'        Sheet1.Range("A2").Resize(UBound(kq, 1), UBound(kq, 2)).Value = kq
'    End If
'    Set fso = Nothing
'End Sub

Sub buivantinh()
Dim r As Long, level As Long, text As String, fso As Object, result, rng As Range
'    xóa kết quả cũ
    Sheet1.UsedRange.Clear
'   tất cả các tập tin trong thư mục "c:1" và các thư mục con, chỉ tên thôi.
    Set fso = CreateObject("Scripting.FileSystemObject")
    ListFilesAndFolders "c:1", result, , "", True
    If Not IsEmpty(result) Then
        For r = 1 To UBound(result, 2)
            level = result(2, r)
            If result(3, r) Then    ' là thư mục -> gom các ô để dùng chữ đỏ.
                If rng Is Nothing Then
                    Set rng = Sheet1.Cells(r, level)
                Else
                    Set rng = Union(rng, Sheet1.Cells(r, level))
                End If
            End If
            If r = 1 Then
                text = result(1, r)
            Else
                text = fso.GetBaseName(result(1, r))
            End If
            Sheet1.Hyperlinks.Add Anchor:=Sheet1.Cells(r, level), Address:=result(1, r), TextToDisplay:=text
        Next r
        If Not rng Is Nothing Then rng.Font.Color = RGB(255, 0, 0)
    End If
    Set fso = Nothing
End Sub

Hướng dẫn:
1. Sub ListFilesAndFolders là code tổng quát dùng để tìm kiếm các thư mục và tập tin. Cùng 1 cách gọi Sub ListFilesAndFolders, tức cùng có một số kết quả như nhau nhưng tùy nhu cầu mà ta có thể trình bầy các kết quả đó theo dạng và trong cấu trúc mà mình mong muốn. Ví dụ cùng tìm thư mục và tập tin trong "C:1" nhưng nếu tôi dùng sub batman1 thì tôi sẽ trình bầy kết quả ở dạng khác, còn bạn sẽ gọi sub buivantinh để trình bầy cũng các kết quả đó nhưng ở dạng khác.
Tóm lại người dùng sẽ gọi Sub ListFilesAndFolders trong code của mình.

Code không chạy a Bat man ạ!

Lưu ý:
1. Bạn thêm code của tôi vào Module1 và vào cả Module2. Hãy vứt bỏ Module2.

2. Sub buivantinh chỉ là VÍ DỤ VỀ CÁCH GỌI sub ListFilesAndFolders. Trong Sub buivantinh là code ví dụ, có dòng

ListFilesAndFolders "c:1", result, , "", True

Trên máy tôi có thư mục "c:1" nên tôi tìm trong thư mục "c:1", trên máy bạn không có thư mục đó thì lấy kết quả từ trên trời à? Thay cho "c:1" thì nhập đường dẫn tới thư mục bắt đầu trên máy của mình.

3. Chú ý là trong code có Sheet1. Nếu tập tin có sheet tên khác thì thay Sheet1 bằng tên đó.

Những lưu ý trên lẽ ra không nên có. Làm gì thì cũng nên suy nghĩ một chút.

okey anh! Em cảm ơn ạ! em gà mờ nên cứ nghĩ bấm run là nó hiện lên hộp thoại yc đường dẫn. haha.

Nếu là tôi thì tôi sẽ suy nghĩ chút như thế này …

batman1 không thể biết mình định tìm trong thư mục nào. Vậy trong code chắc chắn 200% phải có CHỖ NHẬP HOẶC CHỌN thư mục. Nhưng khi chạy code thì không thấy hộp thoại chọn thư mục. Vậy thì 200% thư mục được nhập trong code. Nhưng sao mình nhìn không thấy chỗ nào nhỉ, hay mình không biết nhìn, không biết đọc code? Vậy nên sẽ có câu hỏi: "Bạn ơi, nhập hay chọn thư mục cần tìm ở đâu?". Nhưng bạn lại không đặt câu hỏi đó mà chỉ phán một câu: "Code không chạy a Bat man ạ!"