Duyệt file (folder) trong 1 folder cho trước và tạo Hyperlink

ndu96081631 · 10/6/13

Xét thấy nhiều bạn có nhu cầu duyệt file hoặc folder rồi tạo Hyperlink trên sheet.
Gần đây lại có 1 bạn khơi lại chủ đề này:
http://www.giaiphapexcel.com/forum/showthread.php?81354-Nhờ-Link-foder-trong-trong-excel-!
Bạn ấy lại muốn code có khả năng vừa duyệt file lại vừa duyệt folder nên tôi quyết định tiến hành xây dựng file và cuối cùng cũng hoàn tất
Giao diện chương trình như sau:

Với file này, các bạn có thể lưu thành Add-In và khi gọi Add-In lên các bạn sẽ nhìn thấy 1 button trên menu bar (hoặc Ribbon). Bấm vào button thì form sẽ xuất hiện (như hình trên)
Khi lưu thành Add-In, các bạn sẽ được "khuyến mãi" thêm hàm lấy file, folder như sau

Mã:

Function FilesFoldersList(ByVal RootFolder As String, ByVal ListType As Boolean, _
                          ByVal Search As String, ByVal InSub As Boolean)
  'ListType = True: Get Files list
  'ListType = False: Get Folders list
  Dim sComm As String, tmp As String, str As String, tmpFile, Arr
  On Error Resume Next
  If Right(RootFolder, 1) <> "\" Then RootFolder = RootFolder & "\"
  str = """" & RootFolder & IIf(ListType, Search, "") & """"
 
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    sComm = "DIR " & str & " /ON /B /A" & IIf(ListType, "-", "") & "D[COLOR=#ff0000][B]-S[/B][/COLOR]" & IIf(InSub, "/S", " ") & " >" & tmpFile
    CreateObject("Wscript.Shell").Run "cmd /u /c " & sComm, 0, True
    With .OpenTextFile(tmpFile, 1, , -2)
      tmp = Trim(.ReadAll)
      If Right(tmp, 2) = vbCrLf Then tmp = Left(tmp, Len(tmp) - 2)
      If Len(tmp) Then
        If InSub = False Then tmp = RootFolder & Replace(tmp, vbCrLf, vbCrLf & RootFolder)
        FilesFoldersList = Split(tmp, vbCrLf)
      End If
      .Close
    End With
  End With
  Kill tmpFile
End Function

Có thể gõ hàm trực tiếp trên sheet theo cú pháp:

Mã:

=FilesFoldersList([COLOR=#ff0000]Tên thư mục[/COLOR], [COLOR=#ff8c00]list file hay folder?[/COLOR], [COLOR=#008000]từ khóa[/COLOR], [COLOR=#0000cd]có lấy trong folder con hay không?[/COLOR])

Ví dụ:
=FilesFoldersList("D:\Excel", True, "*.xlsm", True)
Có nghĩa là: Bạn muốn tìm trong thư mục "D:\Excel" các file có đuôi .xlsm và lấy list trong các folder con luôn
Kết quả trả về của hàm trên là mảng 1 chiều chưa các file hoặc folder liên quan
------------------------------------------------
Lưu ý: Trong code chính, chổ màu đỏ (-S) nhằm mục đích loại bỏ các file hoặc folder hệ thống (tránh nguy hiểm). Nếu các bạn có nhu cầu lấy luôn các file folder hệ thống thì cứ xóa cái -S ấy đi là được
------------------------------------------------
Rất mong nhận được sự cải tiến, đóng góp của các bạn để chương trình được hoàn thiện hơn
Cảm ơn!

duyhungvu · 8/8/13

giờ em add được rồi, nhưng bây giờ khi mở file mới hì file Search_For_Files_Folders.xlsm nó cũng chạy ra luôn có cách nào không cho nó chạy ko ạ

ndu96081631 · 8/8/13

downloadungdung đã viết:
giờ em add được rồi, nhưng bây giờ khi mở file mới hì file Search_For_Files_Folders.xlsm nó cũng chạy ra luôn có cách nào không cho nó chạy ko ạ

Vậy xin hỏi: BẠN ĐÃ THAO TÁC THẾ NÀO?

duyhungvu · 8/8/13

dạ vaofile excel bình thường vẫn làm chọn file-options-addinn-manage(excel addin) goto (hộp addin mở ra)chọn Search_For_Files_Folders.xlsm -ok đóng lạitắt file excel đi
nhưng khi mở file đó lại thì nó hiện thêm 1 file Search_For_Files_Folders.xlsm
và file Search_For_Files_Folders.xlsm còn xếp trước file em muốn mở

ndu96081631 · 8/8/13

downloadungdung đã viết:
dạ vaofile excel bình thường vẫn làm chọn file-options-addinn-manage(excel addin) goto (hộp addin mở ra)chọn Search_For_Files_Folders.xlsm -ok đóng lạitắt file excel đi
nhưng khi mở file đó lại thì nó hiện thêm 1 file Search_For_Files_Folders.xlsm
và file Search_For_Files_Folders.xlsm còn xếp trước file em muốn mở

Cái chổ màu đỏ tôi vẫn không hiểu
Khi hộp AddIn mở ra, bạn làm cách nào có thể chọn được kiểu file xlsm vậy? (trong khi nó chỉ cho phép bạn chọn kiểu xlam)
Nếu bạn bấm nút Browse, cố tình chọn All Files (*.*) để có thể duyệt đến kiểu file xlsm thì bạn đã làm sai ---> Quy định tạo Add-In và sử dụng nó phải thế này:
- Đóng hết các file Excel đang mở
- Mở file Search_For_Files_Folders.xlsm
- Bấm nút Save As, khung Save As Type bạn chọn kiểu Excel Add-In (*.xlam). Bấm nút Save
- Đóng file Search_For_Files_Folders.xlsm và không lưu
- Khởi động Excel mới, mở hộp Excel AddIn (như bạn đã làm) rồi check vào "Search_For_Files_Folders" --> OK
Vậy là xong

duyhungvu · 8/8/13

dạ cám ơn thầy em đã làm được rồi
đúng là em đã làm sai thao tác này

Nếu bạn bấm nút Browse, cố tình chọn All Files (*.*) để có thể duyệt đến kiểu file xlsm thì bạn đã làm sai ---> Quy định tạo Add-In và sử dụng nó phải thế này:

hoanglonglk2910 · 6/10/13

Em cần tạo list và Hyperlink như file đính kèm. nhờ các xem dùm em, em gà mờ nên code của thầy em không hiểu được lắm, nhờ các thầy giúp dùm em
File kèm theo View attachment HoiCapnhatTen va hyperlink.xls

ndu96081631 · 6/10/13

hoanglonglk2910 đã viết:
Em cần tạo list và Hyperlink như file đính kèm. nhờ các xem dùm em, em gà mờ nên code của thầy em không hiểu được lắm, nhờ các thầy giúp dùm em
File kèm theo View attachment 110191

Thế sao bạn không tải file ở bài 1 về mà dùng? Mọi thứ có sẵn cả, chỉ việc xài, còn hỏi gì nữa?
(chắc đòi cơm dâng tới miệng đây?)

hoanglonglk2910 · 6/10/13

thầy đừng la tội em, em đã tải về mà xem trong đó em chẳng hiểu là một phần, một phần em chỉ muốn tạo theo ý đồ của em thôi mà không hiểu code, nhờ các thầy giúp dùm em

ndu96081631 · 6/10/13

hoanglonglk2910 đã viết:
thầy đừng la tội em, em đã tải về mà xem trong đó em chẳng hiểu là một phần, một phần em chỉ muốn tạo theo ý đồ của em thôi mà không hiểu code, nhờ các thầy giúp dùm em

Bạn cần gì hiểu code, biết xài là được rồi (cũng giống như bạn học cách xài hàm Excel vậy)
Biết xài ở đây là: Biết cách Enable Macros, chỉ thế thôi

hoanglonglk2910 · 6/10/13

Nếu thầy có thời gian nhờ thầy giúp dùm em, nếu không thầy sửa giúp em từ code của thầy dòng NO PATH SIZE DA CREATE thành No(STT) PATH (ĐƯỜNG DẪN) SIZE(KÍCH THƯỚC) DATA CREATE (NGÀY TẠO) và THẦY THÊM DÙM EM MỘT CỘT, CỘT NÀY HIỆN TÊN FILE nha thầy. em cám ơn thầy.

ndu96081631 · 6/10/13

hoanglonglk2910 đã viết:
Nếu thầy có thời gian nhờ thầy giúp dùm em, nếu không thầy sửa giúp em từ code của thầy dòng NO PATH SIZE DA CREATE thành No(STT) PATH (ĐƯỜNG DẪN) SIZE(KÍCH THƯỚC) DATA CREATE (NGÀY TẠO) và THẦY THÊM DÙM EM MỘT CỘT, CỘT NÀY HIỆN TÊN FILE nha thầy. em cám ơn thầy.

Cách đơn giản mà khỏi phải suy nghĩ gì: Cứ chạy code (trên file của tôi), xong, copy dữ liệu nhận được qua file của bạn
Nếu sửa code theo ý bạn thì chỉ có mình bạn xài, không tổng quát
(mà tôi ghét nhất là viết code dạng không tổng quát, chỉ xài 1 lần rồi liệng, chả bõ công)

ducboss · 19/4/14

Mình thấy "[h=2]Duyệt file (folder) trong 1 folder cho trước và tạo Hyperlink[/h]"
là cũng tuyệt rồi. Nhưng mà ở đây mình muốn quản lý dữ liệu thông qua cái này. Nếu như việc liệt kê trên và tạo Hyperlink 2 chiều thì tốt quá.

VD: Nếu sửa tên file, folder hoặc tạo thêm file và folder mà nó tự động cập nhật lên file excel của mình. Còn làm được cả ngược lại thì quá tối ưu trong việc quản lý dữ liệu.

Thanks!

theducw87 · 14/9/14

ndu96081631 đã viết:
Xét thấy nhiều bạn có nhu cầu duyệt file hoặc folder rồi tạo Hyperlink trên sheet.
Gần đây lại có 1 bạn khơi lại chủ đề này:
http://www.giaiphapexcel.com/forum/showthread.php?81354-Nhờ-Link-foder-trong-trong-excel-!
Bạn ấy lại muốn code có khả năng vừa duyệt file lại vừa duyệt folder nên tôi quyết định tiến hành xây dựng file và cuối cùng cũng hoàn tất
Giao diện chương trình như sau:

View attachment 103678

Với file này, các bạn có thể lưu thành Add-In và khi gọi Add-In lên các bạn sẽ nhìn thấy 1 button trên menu bar (hoặc Ribbon). Bấm vào button thì form sẽ xuất hiện (như hình trên)
Khi lưu thành Add-In, các bạn sẽ được "khuyến mãi" thêm hàm lấy file, folder như sau

Mã:

Function FilesFoldersList(ByVal RootFolder As String, ByVal ListType As Boolean, _ ByVal Search As String, ByVal InSub As Boolean) 'ListType = True: Get Files list 'ListType = False: Get Folders list Dim sComm As String, tmp As String, str As String, tmpFile, Arr On Error Resume Next If Right(RootFolder, 1) <> "\" Then RootFolder = RootFolder & "\" str = """" & RootFolder & IIf(ListType, Search, "") & """" With CreateObject("Scripting.FileSystemObject") tmpFile = .GetTempName sComm = "DIR " & str & " /ON /B /A" & IIf(ListType, "-", "") & "D[COLOR=#ff0000][B]-S[/B][/COLOR]" & IIf(InSub, "/S", " ") & " >" & tmpFile CreateObject("Wscript.Shell").Run "cmd /u /c " & sComm, 0, True With .OpenTextFile(tmpFile, 1, , -2) tmp = Trim(.ReadAll) If Right(tmp, 2) = vbCrLf Then tmp = Left(tmp, Len(tmp) - 2) If Len(tmp) Then If InSub = False Then tmp = RootFolder & Replace(tmp, vbCrLf, vbCrLf & RootFolder) FilesFoldersList = Split(tmp, vbCrLf) End If .Close End With End With Kill tmpFile End Function

Có thể gõ hàm trực tiếp trên sheet theo cú pháp:

Mã:

=FilesFoldersList([COLOR=#ff0000]Tên thư mục[/COLOR], [COLOR=#ff8c00]list file hay folder?[/COLOR], [COLOR=#008000]từ khóa[/COLOR], [COLOR=#0000cd]có lấy trong folder con hay không?[/COLOR])

Ví dụ:
=FilesFoldersList("D:\Excel", True, "*.xlsm", True)
Có nghĩa là: Bạn muốn tìm trong thư mục "D:\Excel" các file có đuôi .xlsm và lấy list trong các folder con luôn
Kết quả trả về của hàm trên là mảng 1 chiều chưa các file hoặc folder liên quan
------------------------------------------------
Lưu ý: Trong code chính, chổ màu đỏ (-S) nhằm mục đích loại bỏ các file hoặc folder hệ thống (tránh nguy hiểm). Nếu các bạn có nhu cầu lấy luôn các file folder hệ thống thì cứ xóa cái -S ấy đi là được
------------------------------------------------
Rất mong nhận được sự cải tiến, đóng góp của các bạn để chương trình được hoàn thiện hơn
Cảm ơn!

Thầy có thể tùy chỉnh addin này giúp em thành liệt kê theo cây thư mục được không thầy? Em chỉ cần duyệt theo fodel hiện theo cấu trúc mà em đã lưu file trên ổ cứng, ví dụ như hình vẽ em đính kèm. Cảm ơn thầy.

be_09 · 28/10/14

theducw87 đã viết:
Thầy có thể tùy chỉnh addin này giúp em thành liệt kê theo cây thư mục được không thầy? Em chỉ cần duyệt theo fodel hiện theo cấu trúc mà em đã lưu file trên ổ cứng, ví dụ như hình vẽ em đính kèm. Cảm ơn thầy.

Cái yêu cầu của bạn là chưa thực tế, duyệt qua các Folder không biết bạn muốn làm như trên mục đích để làm gì thì bạn cần nêu vấn đề rõ ràng hơn, hay là bạn cần cái cao siêu quá mà tôi nghĩ không ra.

Theo tôi nghĩ bạn muốn phân loại các Foler, các File chứa trong folder đó sau đó tổng hợp các loại file.

lhthai · 16/5/15

Lấy link tất cả file trong folder theo điều kiện

Hiện tại mình có file lấy link tất cà các file trong Folder nay muốn bổ sung thêm điều kiện
Lấy tất cả các file theo điều kiện tại vùng I3:I1000 (Ý mình chỉ muốn lấy những link theo điều kiện này thôi)

Mã:

Sub ChonDia()
With Application.FileDialog(msoFileDialogFolderPicker)
   If .Show Then
   Sheet1.TextBox1 = .SelectedItems(1)
   End If
End With
End Sub
------------------------------------------------------------------------------------------------
Function FilesFoldersList(ByVal RootFolder As String, ByVal ListType As Boolean, _
                          ByVal Search As String, ByVal InSub As Boolean)
  'ListType = True: Get Files list
  'ListType = False: Get Folders list
  Dim sComm As String, tmp As String, str As String, tmpFile, Arr
  On Error Resume Next
  If Right(RootFolder, 1) <> "\" Then RootFolder = RootFolder & "\"
  str = """" & RootFolder & IIf(ListType, Search, "") & """"
  
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    sComm = "DIR " & str & " /ON /B /A" & IIf(ListType, "-", "") & "D-S" & IIf(InSub, "/S", " ") & " >" & tmpFile
    CreateObject("Wscript.Shell").Run "cmd /u /c " & sComm, 0, True
    With .OpenTextFile(tmpFile, 1, , -2)
      tmp = Trim(.ReadAll)
      If Right(tmp, 2) = vbCrLf Then tmp = Left(tmp, Len(tmp) - 2)
      If Len(tmp) Then
        If InSub = False Then tmp = RootFolder & Replace(tmp, vbCrLf, vbCrLf & RootFolder)
        FilesFoldersList = Split(tmp, vbCrLf)
      End If
      .Close
    End With
  End With
  Kill tmpFile
End Function
-----------------------------------------------------------------------------------------------
Sub Link()
Dim Arr, i As Long, k As Long, Count As Long
Dim Dic As Object
On Error Resume Next
Set Dic = CreateObject("Scripting.FileSystemObject")
    Arr = FilesFoldersList(Sheet1.TextBox1, True, "*" & [COLOR=#ff0000]Sheet1.Range("I2") & "*.*",[/COLOR] Sheet1.CheckBox1)
        Range("B9:G65536").Clear
        k = 1 - LBound(Arr)
        For i = LBound(Arr) To UBound(Arr)
        With Range("B9").Offset(i)
          .Offset(, 0) = i + k
          .Offset(, 1) = Dic.GetFile(Arr(i)).Name
          .Offset(, 2) = Int(Dic.GetFile(Arr(i)).Size / 1024)
          .Offset(, 3) = Dic.GetFile(Arr(i)).Type
          .Offset(, 4) = Dic.GetFile(Arr(i)).DateCreated
          .Offset(, 5).Hyperlinks.Add .Offset(, 5), Arr(i), , , "Click mo File"
        End With
        Next
End Sub

lhthai · 16/5/15

Mình chỉ cần tìm kiếm những file cần thôi
điệu kiện ô chổ tô màu đỏ

Mã:

Sub ChonDia()
With Application.FileDialog(msoFileDialogFolderPicker)
   If .Show Then
   Sheet1.TextBox1 = .SelectedItems(1)
   End If
End With
End Sub
Function FilesFoldersList(ByVal RootFolder As String, ByVal ListType As Boolean, _
                          ByVal Search As String, ByVal InSub As Boolean)
  'ListType = True: Get Files list
  'ListType = False: Get Folders list
  Dim sComm As String, tmp As String, str As String, tmpFile, Arr
  On Error Resume Next
  If Right(RootFolder, 1) <> "\" Then RootFolder = RootFolder & "\"
  str = """" & RootFolder & IIf(ListType, Search, "") & """"
  
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    sComm = "DIR " & str & " /ON /B /A" & IIf(ListType, "-", "") & "D-S" & IIf(InSub, "/S", " ") & " >" & tmpFile
    CreateObject("Wscript.Shell").Run "cmd /u /c " & sComm, 0, True
    With .OpenTextFile(tmpFile, 1, , -2)
      tmp = Trim(.ReadAll)
      If Right(tmp, 2) = vbCrLf Then tmp = Left(tmp, Len(tmp) - 2)
      If Len(tmp) Then
        If InSub = False Then tmp = RootFolder & Replace(tmp, vbCrLf, vbCrLf & RootFolder)
        FilesFoldersList = Split(tmp, vbCrLf)
      End If
      .Close
    End With
  End With
  Kill tmpFile
End Function
Sub Link()
Dim Arr, i As Long, k As Long, Count As Long
Dim Dic As Object
On Error Resume Next
Set Dic = CreateObject("Scripting.FileSystemObject")
    Arr = FilesFoldersList(Sheet1.TextBox1, True, [COLOR=#ff0000]"*" & Sheet1.Range("I2") & "*.*"[/COLOR], Sheet1.CheckBox1)
        Range("B9:G65536").Clear
        k = 1 - LBound(Arr)
        For i = LBound(Arr) To UBound(Arr)
        With Range("B9").Offset(i)
          .Offset(, 0) = i + k
          .Offset(, 1) = Dic.GetFile(Arr(i)).Name
          .Offset(, 2) = Int(Dic.GetFile(Arr(i)).Size / 1024)
          .Offset(, 3) = Dic.GetFile(Arr(i)).Type
          .Offset(, 4) = Dic.GetFile(Arr(i)).DateCreated
          .Offset(, 5).Hyperlinks.Add .Offset(, 5), Arr(i), , , "Click mo File"
        End With
        Next
End Sub

haiuyen · 14/7/15

Các anh chị cho mình hỏi chút là hình như file này chỉ chạy với system type 32 bit thui đúng không.
Mình down về dùng thử nhưng máy mình là 64 bit nên không chạy.
Mọi người giúp mình làm thế nào để có thể chạy được không.

Cảm ơn mọi người nhiều.

kbw1 · 14/7/15

Cái này hơn hyperlink của ex đúng ko các bạn?

lhthai · 14/7/15

haiuyen đã viết:
Các anh chị cho mình hỏi chút là hình như file này chỉ chạy với system type 32 bit thui đúng không.
Mình down về dùng thử nhưng máy mình là 64 bit nên không chạy.
Mọi người giúp mình làm thế nào để có thể chạy được không.

Cảm ơn mọi người nhiều.

Mình dùng win 64bit chạy bình thường.

ldhm · 21/3/17

Thầy ơi! Nếu em chỉ muốn lấy tên file không cần đường dẫn có được không ạ!

Duyệt file (folder) trong 1 folder cho trước và tạo Hyperlink

Huyền thoại GPE

File đính kèm

Thành viên mới

Huyền thoại GPE

Thành viên mới

Huyền thoại GPE

Thành viên mới

Thành viên mới

Huyền thoại GPE

Thành viên mới

Huyền thoại GPE

Thành viên mới

Huyền thoại GPE

Thành viên mới

Thành viên chính thức

File đính kèm

Biên Hòa, Đồng Nai

Thành viên thường trực

Thành viên thường trực

Thành viên mới

Thành viên tích cực

Thành viên thường trực

Thành viên mới