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

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!

KUMI · 15/6/13

Thưa Thầy có thể Duệt cả file lẫn foder trong trong cùng 1 thư mục được không ạ?
Ví dụ trong thư mục này

:\Documents and Settings\Administrator\My Documents\Downloads
Có các foder

ocuments,Compressed,Music,Programs v.v..
và các file :A.xls,B.doc,C.xls,

Con muốn khi duyệt theo đường dẫn trên thì có các đường liks vào các forder trên và các đường links vào file trên.
Như vậy trong bảng sẽ hiện ra như thế này:
Documents
Compressed
Music
Programs
A.xls
B.doc
C.xls
(không lấy đường dẫn kèm theo mà chỉ lấy tên thôi ạ)
Chứ không có nghĩ là duyệt luôn tất cả các file năm trong các foder trong thư mục theo đường dẫn trên ạ!
Hix! Hỏi thôi mà con đã thấy thật vất vả và khó diễn đạt rồi. Không biết Thầy và mọi người có hiểu ý không, hihi!

TrungChinhs · 16/6/13

KUMI đã viết:
Thưa Thầy có thể Duệt cả file lẫn foder trong trong cùng 1 thư mục được không ạ?
Ví dụ trong thư mục này :\Documents and Settings\Administrator\My Documents\Downloads
Có các foderocuments,Compressed,Music,Programs v.v..
và các file :A.xls,B.doc,C.xls,

Con muốn khi duyệt theo đường dẫn trên thì có các đường liks vào các forder trên và các đường links vào file trên.
Như vậy trong bảng sẽ hiện ra như thế này:
Documents
Compressed
Music
Programs
A.xls
B.doc
C.xls
(không lấy đường dẫn kèm theo mà chỉ lấy tên thôi ạ)
Chứ không có nghĩ là duyệt luôn tất cả các file năm trong các foder trong thư mục theo đường dẫn trên ạ!
Hix! Hỏi thôi mà con đã thấy thật vất vả và khó diễn đạt rồi. Không biết Thầy và mọi người có hiểu ý không, hihi!

Bạn viết như thế này là khá rõ rồi.

Trong bài này của Ndu thì duyệt File riêng và duyệt thư mục riêng (có 2 lựa chọn) nhưng trong một bài khác (cũng của ndu trên GPE) thì có bài duyệt cả fold và file trong 1 thư mục nhưng hình như là không có Hyperlink. Bạn thử tìm xem.

siwtom · 17/6/13

Tôi không cần ai cám ơn đâu. Cái tôi cần là test hộ. Rất nhiều lần tôi nhờ test hộ thì chả ai giúp tôi cả. Tại sao tôi nhờ test? Cái thứ nhất là xem tốc độ. Cái nữa là biết đâu code sai. Thường thì cái lỗi của người khác nhìn bao giờ cũng thấy như con voi còn lỗi của bản thân nó cứ như con kiến ấy. Vì thế con người ai cũng nhìn thấy rõ lỗi của người khác nhưng lỗi của bản thân sao khó thấy thế.
----------------
Tôi tự phát hiện ra trường hợp thiếu kết quả. Khi filename = "*" thì có đầy đủ kết quả. Khi vd. filename = "*.txt" và SubDir = TRUE thì kết quả trả về y như là SubDir = FALSE, tức chỉ có kết quả khớp từ thư mục đầu tiên. Trong code dưới những chỗ sửa hoặc thêm vào tôi đánh dấu mầu đỏ đỏ. Nhờ mọi người tiếp tục kiểm tra hộ
------------
Nhân tiện nhờ mọi người test hộ. Tôi muốn test chủ yếu cho trường hợp tìm các tập tin hoặc cả tập tin và thư mục, tìm cả ở các thư mục con. Kết quả trả về là tên, độ lớn và ngày tạo. Thư mục bắt đầu là "C:\" Code của tôi không lấy các tập tin và thư mục có trong sọt rác - RECYCLE, RECYCLER Tóm lại là chạy code sub myTest. Module

Mã:

Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE As Long = &HFFFFFFFF  '((Handle) - 1)

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Public Enum FIND_FILE_OPTION
    FileOnly = 1
    DirectoryOnly = 2
    AllFiles = 3
End Enum

Public Enum FIND_RESULT_OPTION
    frName = 1
    frNameSize = 3
    frNameDate = 5
    frNameSizeDate = 7
End Enum

Private Declare Function FileTimeToLocalFileTime Lib "kernel32.dll" (ByRef lpFileTime As FILETIME, ByRef lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32.dll" (ByRef lpFileTime As FILETIME, ByRef lpSystemTime As SYSTEMTIME) As Long

Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFileW Lib "kernel32.dll" (ByVal lpFileName As String, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFileW Lib "kernel32.dll" (ByVal hFindFile As Long, ByRef lpFindFileData As WIN32_FIND_DATA) As Long

Private Const recycle = "RECYCLE"

Function UTCtoSysTime(fTime As FILETIME) As String
Dim LocalFileTime As FILETIME, SysTime As SYSTEMTIME
    If ((fTime.dwLowDateTime <> 0) Or (fTime.dwHighDateTime <> 0)) And _
      FileTimeToLocalFileTime(fTime, LocalFileTime) And FileTimeToSystemTime(LocalFileTime, SysTime) Then
        UTCtoSysTime = DateSerial(SysTime.wYear, SysTime.wMonth, SysTime.wDay) & " " _
            & TimeSerial(SysTime.wHour, SysTime.wMinute, 0)
    End If
End Function

Sub FindMatchedFilesExtW(arr, DirSize As Double, ByVal DirStart As String, ByVal filename As String, Optional ByVal res_option As FIND_RESULT_OPTION = frName, _
    Optional ByVal SubDir As Boolean = True, Optional ByVal find_option As FIND_FILE_OPTION = FileOnly)
' Arr: maŇng chýěa kęět quaŇ traŇ vęĚ laĚ maŇng 2 chięĚu
' SubDir: nęěu TRUE thiĚ tim caŇ trong caěc thý muňc con
' find_option = 3 (AllFiles) - tiĚm tâňp tin vaĚ thý muňc, 1 (FileOnly) - chiŇ tiĚm tâňp tin, 2 (DirectoryOnly) - chiŇ tiĚm thý muňc
'    DirSize chi dung cho vai th, vd. filename = "*", find_option = FileOnly, SubDir = True
'    ----------------------------------------
'    vd. caěch duĚng
'    FindMatchedFilesExtW arr, size, "C:\", "*", frNameSizeDate, , FileOnly
'    Application.ScreenUpdating = False
'    Range("A1").Resize(UBound(arr) + 1, UBound(arr, 2) + 1).Value = arr
'    Application.ScreenUpdating = True
    
Dim FindData As WIN32_FIND_DATA
Dim FindHandle As Long
Dim validDir As Boolean, IsFile As Boolean, doAdd As Boolean
Dim fName As String, k As Long, r As Long, c As Long, dSize As Double, size As Long
Static level As Long
On Error Resume Next

    If Right(DirStart, 1) <> "\" Then DirStart = DirStart & "\"
    
    [B][COLOR=#ff0000]If Not SubDir And (find_option = FileOnly) Then      [/COLOR][/B][COLOR=#ff0000][/COLOR][COLOR=#0000ff]<--- thay cho [/COLOR][COLOR=#ff0000]fName = StrConv(DirStart & filename, vbUnicode)[/COLOR]
[B][COLOR=#ff0000]        fName = StrConv(DirStart & filename, vbUnicode)
    Else
        fName = StrConv(DirStart & "*", vbUnicode)
    End If[/COLOR][/B]
    
    FindHandle = FindFirstFileW(fName, FindData)
    
    If FindHandle <> INVALID_HANDLE_VALUE Then
        If res_option = frName Then
            size = 0
        ElseIf res_option = frNameSizeDate Then
            size = 2
        Else
            size = 1
        End If
        doAdd = SubDir Or (level = 0)
        Do
            fName = StrConv(FindData.cFileName, vbFromUnicode)
            k = InStr(1, fName, vbNullChar)
            fName = Left(fName, k - 1)
            
            validDir = (FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY
            IsFile = Not validDir
            
            If IsFile Then DirSize = DirSize + FindData.nFileSizeLow
            
            If validDir Then validDir = (Left(fName, 1) <> ".") And (InStr(1, fName, recycle, vbTextCompare) <> 1)

            If validDir Then
                If SubDir Or ((find_option > 1) And ((res_option And 2) = 2)) Then
                    level = level + 1
                    dSize = 0
                    FindMatchedFilesExtW arr, dSize, DirStart & fName, filename, res_option, SubDir, find_option
                    level = level - 1
                    DirSize = DirSize + dSize
                End If
            End If
            [B][COLOR=#ff0000]If fName Like filename Then[/COLOR][/B]    [COLOR=#0000ff]<--- them[/COLOR]
                If doAdd And ((validDir And (find_option > 1)) Or (IsFile And (find_option <> 2))) Then
                    If IsEmpty(arr) Then
                        ReDim arr(0 To size)
                    Else
                        ReDim Preserve arr(0 To UBound(arr) + size + 1)
                    End If
                    
                    arr(UBound(arr) - size) = DirStart & fName
                    If (res_option And 2) = 2 Then
                        If IsFile And (find_option <> 2) Then
                            arr(UBound(arr) - size + 1) = FindData.nFileSizeLow
                        Else
                            arr(UBound(arr) - size + 1) = dSize
                        End If
                    End If
                    
                    If (res_option And 4) = 4 Then arr(UBound(arr)) = UTCtoSysTime(FindData.ftCreationTime)
                End If
            [B][COLOR=#ff0000]End If[/COLOR][/B]     [COLOR=#0000ff]<--- them[/COLOR]
        Loop Until FindNextFileW(FindHandle, FindData) = 0
        FindClose (FindHandle)
    End If
   
    If level = 0 Then
        ReDim resArr(0 To (UBound(arr) + 1) \ (size + 1) - 1, 0 To size) As String
        For r = 0 To UBound(resArr)
            k = (size + 1) * r
            For c = 0 To size
                resArr(r, c) = arr(k + c)
            Next c
        Next r
        arr = resArr
    End If
End Sub

Sub myTest()
Dim t As Double, arr, size As Double
    Range("A:C").Clear
    
    t = Timer
    FindMatchedFilesExtW arr, size, "c:\", "*", frNameSizeDate, , FileOnly
    If IsEmpty(arr) Then Exit Sub
    Debug.Print "siwtom code: " & UBound(arr) + 1 & " files (or folders) found!", , Format(Timer - t, "0.0") & "s"
    Debug.Print size
    
    Application.ScreenUpdating = False
    Range("A1").Resize(UBound(arr) + 1, UBound(arr, 2) + 1).Value = arr
    Application.ScreenUpdating = True
End Sub

Ngoai Thanh · 17/6/13

Trời ơi, khiếp quá, mỗi cái ổ C:\ mà lên đến sấp sỉ 50.000 tệp . Cám ơn thầy . Nhưng nếu thày viết cho duyệt một thư mục bất kỳ nào đó khi cho đường dẫn thì hay quá.

siwtom · 17/6/13

Ngoai Thanh đã viết:
Trời ơi, khiếp quá, mỗi cái ổ C:\ mà lên đến sấp sỉ 50.000 tệp . Cám ơn thầy . Nhưng nếu thày viết cho duyệt một thư mục bất kỳ nào đó khi cho đường dẫn thì hay quá.

Bạn nói tới bài của tôi? Nếu thế thì duyệt thư mục nào thì cho DirStart = thư mục đó. Còn filename thì vd. filename = "*" - tất cả, hoặc filename = "*.txt" - chỉ các file TXT

hungpecc1 · 17/6/13

siwtom đã viết:
Tôi không cần ai cám ơn đâu. Cái tôi cần là test hộ. Rất nhiều lần tôi nhờ test hộ thì chả ai giúp tôi cả.
Tại sao tôi nhờ test? Cái thứ nhất là xem tốc độ. Cái nữa là biết đâu code sai. Thường thì cái lỗi của người khác nhìn bao giờ cũng thấy như con voi còn lỗi của bản thân nó cứ như con kiến ấy. Vì thế con người ai cũng nhìn thấy rõ lỗi của người khác nhưng lỗi của bản thân sao khó thấy thế.
----------------
Nhân tiện nhờ mọi người test hộ. Tôi muốn test chủ yếu cho trường hợp tìm các tập tin hoặc cả tập tin và thư mục, tìm cả ở các thư mục con. Kết quả trả về là tên, độ lớn và ngày tạo. Thư mục bắt đầu là "C:\"
Code của tôi không lấy các tập tin và thư mục có trong sọt rác - RECYCLE, RECYCLER
Tóm lại là chạy code sub myTest.

Emt test thử Debug.Print báo như vậy :

PHP:

siwtom code: 167313 files (or folders) found!  63.3s
 37828117695

Em thấy ok,tất cả các file xxx, abc,xyz .. hidden cũng liệt kê ra hết __--__

Ngoai Thanh · 17/6/13

Ý nhà em là khi ta gọi sub Mytext thì xuất hiện hộp thoại để ta nhập đường dẫn cần duyệt vào đó thầy ạ ?

ndu96081631 · 17/6/13

Ngoai Thanh đã viết:
Ý nhà em là khi ta gọi sub Mytext thì xuất hiện hộp thoại để ta nhập đường dẫn cần duyệt vào đó thầy ạ ?

Anh siwtom chẳng khi nào làm trọn vẹn 1 ứng dụng nào đâu. Ở trên chỉ là code dạng giải thuật, dùng thế nào là chuyện của bạn
Bạn muốn có hộp gì đó thì bài 1 đấy còn gì

Ngoai Thanh · 17/6/13

trời ơi, nhà em tải về rồi, nhưng do nhà em vẫn dùng office 2003 "đồ cổ" nên không mở được đuôi .xlsm , không biết có cách nào để đọc không nữa, nhà em bó tay thày ạ . Vả lại code của thày Wistom có cả dung lượng và thời gian khởi tạo . Nếu máy tự nhiên trục trặc, Có thể dùng code lọc thời gian để kiểm tra các tập tin khởi tạo trong thời gian trước đó .

ndu96081631 · 17/6/13

Ngoai Thanh đã viết:
trời ơi, nhà em tải về rồi, nhưng do nhà em vẫn dùng office 2003 "đồ cổ" nên không mở được đuôi .xlsm , không biết có cách nào để đọc không nữa, nhà em bó tay thày ạ.

Tôi dùng đuôi xlsm là có lý do. Thử nghĩ bạn tìm trong ổ C được 80,000 file thì làm sao liệt kê trên file xls đây? (xls chỉ có 65536 dòng)
Nếu muốn, tôi chuyển xlsm sang xls cho bạn ---> xem ở bài 1 nhé

Ngoai Thanh đã viết:
Vả lại code của thày Wistom có cả dung lượng và thời gian khởi tạo . Nếu máy tự nhiên trục trặc, Có thể dùng code lọc thời gian để kiểm tra các tập tin khởi tạo trong thời gian trước đó .

Thì code của tôi cũng có đầy đủ đấy thôi (Tên file, dung lượng, ngày tạo) tùy bạn chọn trên UserForm. Mặc khác còn tạo được Hyperlink trên sheet (cũng tùy bạn chọn luôn)

thanchetvnt · 17/6/13

siwtom đã viết:
Tôi không cần ai cám ơn đâu. Cái tôi cần là test hộ. Rất nhiều lần tôi nhờ test hộ thì chả ai giúp tôi cả.
Tại sao tôi nhờ test? Cái thứ nhất là xem tốc độ. Cái nữa là biết đâu code sai. Thường thì cái lỗi của người khác nhìn bao giờ cũng thấy như con voi còn lỗi của bản thân nó cứ như con kiến ấy. Vì thế con người ai cũng nhìn thấy rõ lỗi của người khác nhưng lỗi của bản thân sao khó thấy thế.
----------------

Nhân tiện nhờ mọi người test hộ. Tôi muốn test chủ yếu cho trường hợp tìm các tập tin hoặc cả tập tin và thư mục, tìm cả ở các thư mục con. Kết quả trả về là tên, độ lớn và ngày tạo. Thư mục bắt đầu là "C:\"
Code của tôi không lấy các tập tin và thư mục có trong sọt rác - RECYCLE, RECYCLER
Tóm lại là chạy code sub myTest.

Mình test thì báo lỗi như hình dưới đây.

ndu96081631 · 17/6/13

thanchetvnt đã viết:
Mình test thì báo lỗi như hình dưới đây.

Có lẽ bạn dùng code trên Excel 2003? Bị lỗi vì không đủ chổ chứa thôi ( bảng tính Excel 2003 chỉ chứa được 65536 file)

Ngoai Thanh · 17/6/13

ndu96081631 đã viết:
Tôi dùng đuôi xlsm là có lý do. Thử nghĩ bạn tìm trong ổ C được 80,000 file thì làm sao liệt kê trên file xls đây? (xls chỉ có 65536 dòng)
Nếu muốn, tôi chuyển xlsm sang xls cho bạn ---> xem ở bài 1 nhé

Thì code của tôi cũng có đầy đủ đấy thôi (Tên file, dung lượng, ngày tạo) tùy bạn chọn trên UserForm. Mặc khác còn tạo được Hyperlink trên sheet (cũng tùy bạn chọn luôn)

Cám ơn thày, nhà em phục thày lắm , chỉ sợ đêm nằm mà gọi tên thày thì ...vợ em nó véo tai chết .

siwtom · 17/6/13

ndu96081631 đã viết:
Anh siwtom chẳng khi nào làm trọn vẹn 1 ứng dụng nào đâu. Ở trên chỉ là code dạng giải thuật, dùng thế nào là chuyện của bạn
Bạn muốn có hộp gì đó thì bài 1 đấy còn gì

Đúng thế. Đó chỉ là sub thôi. Tức "lấy" các tập tin và thư mục khớp. Còn "lấy" thư mục DirStart bằng cách nào hoặc mảng kết quả dùng làm việc khác hay để đập xuống sheet là tùy người dùng.
Mà chọn thư mục bắt đầu thì trong code của ndu đã có rồi, cứ bắt chước thôi.
Tất nhiên tôi test cho "C:\" và tìm tất cả nên chắc chắn Arr <> Empty. Trong th tổng quát thì trước khi dùng Arr phải kiểm tra vì có thể với đk tìm kiếm thì không tìm thấy kất quả nào, tức Arr = Empty

Mã:

    FindMatchedFilesExtW ...
    If not IsEmpty(arr) Then ...

siwtom · 17/6/13

Tôi có sửa chút trong bài #4
Nhờ mọi người test hộ.

thanhtrg · 5/7/13

KUMI đã viết:
Thưa Thầy có thể Duệt cả file lẫn foder trong trong cùng 1 thư mục được không ạ?
Ví dụ trong thư mục này :\Documents and Settings\Administrator\My Documents\Downloads
Có các foderocuments,Compressed,Music,Programs v.v..
và các file :A.xls,B.doc,C.xls,

Con muốn khi duyệt theo đường dẫn trên thì có các đường liks vào các forder trên và các đường links vào file trên.
Như vậy trong bảng sẽ hiện ra như thế này:
Documents
Compressed
Music
Programs
A.xls
B.doc
C.xls
(không lấy đường dẫn kèm theo mà chỉ lấy tên thôi ạ)
Chứ không có nghĩ là duyệt luôn tất cả các file năm trong các foder trong thư mục theo đường dẫn trên ạ!
Hix! Hỏi thôi mà con đã thấy thật vất vả và khó diễn đạt rồi. Không biết Thầy và mọi người có hiểu ý không, hihi!

Với macro đơn giản, gọn nhẹ sau đây có thể đáp ứng yêu cầu của bạn

Miền Cát Trắng · 5/7/13

Bạn đang chia sẻ kiến thức hay là biểu diễn tài năng vậy?

thanhtrg đã viết:
Với macro đơn giản, gọn nhẹ sau đây có thể đáp ứng yêu cầu của bạn

Vì sao lại phải đặt password VBA ???
Có thể ở khu vực bạn làm việc vấn đề Password này là nan giải.Nhưng ở GPE này với cái pas của bạn thì chỉ cần 1 cái kích chuột là xong toàn tập.(Bạn có cần thử không?Nếu ai đã được đọc các bài viết của thầy switom thì đều biết cả.)

Bạn nên hiểu rõ 1 điều rằng: GPE này là nơi chia sẽ kiến thức chứ không phải là nơi sô lô trình độ bạn à.
Nếu trình độ của bạn chỉ cần hơn hẳn 1 trong số người ở câp 1 sao vàng không xoay thôi thì tôi nghĩ bạn thừa hiểu được là vấn đề Password của bạn chỉ là trò trẻ con, và qua cách đặt password của bạn mọi người trong GPE cũng có thể đoán được trình độ của bạn tồi ở mức nào!

duyhungvu · 8/8/13

bài này hay quá nhưng sao khi add vào thì nó chỉ có sheet 1 thôi nhỉ cái này em muốn add vào mà khi mở file excel nào cũng có cái addin này thì làm sao ạ

ndu96081631 · 8/8/13

downloadungdung đã viết:
bài này hay quá nhưng sao khi add vào thì nó chỉ có sheet 1 thôi nhỉ cái này em muốn add vào mà khi mở file excel nào cũng có cái addin này thì làm sao ạ

Thì bạn lưu file thành Add-In đi, sẽ dùng được với bất cứ file nào trên máy tính của bạn mỗi khi khởi động Excel

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 ạ!

be_09 · 21/3/17

ducboss đã viết:
Mình thấy cũng tuyệt rồi, mình muốn quản lý dữ liệu thông qua cái này, nếu tạo Hyperlink được 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!

Bạn có ví dụ với kết quả trong File rồi đưa lên đây tôi xem thử.

be_09 · 21/3/17

ldhm đã viết:
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 ạ!

Bạn dùng thử File này.

CRAZYMA · 15/4/17

Xin chào các bạn trên diễn đàn và tác giả ndu
ờ bài #1 mình có tải file Search_For_Files_Folders.xlsm của tác giả ndu về và thử lấy với folder có 1 số file sau:
050607.xlsx
050706.xlsx
060507.xlsx
060705.xlsx
070506.xlsx
070605.xlsx
với điều kiện tên file cần lấy là: *06??.xlsx (mục đích của mình là lấy tất cả các file có ký tự 06 ở giữa tên file) nhưng khi lấy file thì kết quả cho ra các file sau:
050607.xlsx
050706.xlsx
070506.xlsx
070605.xlsx
nếu dùng trình Search trong win tìm trong folder với các file trên thì kết quả cho ra chỉ có 2 file (đây là kết quả đúng) là:
050607.xlsx
070605.xlsx
Mình nhận thấy hình như lệnh trong cmd nhận ký tự đại diện khác với win hay sao đó
Các bạn trên diễn đàn và tác giả ndu có thể giải thích cho mình được không

ndu96081631 · 15/4/17

CRAZYMA đã viết:
Mình nhận thấy hình như lệnh trong cmd nhận ký tự đại diện khác với win hay sao đó
Các bạn trên diễn đàn và tác giả ndu có thể giải thích cho mình được không

Tôi cũng không rõ nguyên nhân lắm. Tuy nhiên tôi thắc mắc sao bạn không gõ từ khóa dò tìm là ??06??.xlsx
???

CRAZYMA · 17/4/17

Lý do em nhập từ khóa *06??.xlsx như vậy vì có thể trong Folder có thể có các file có tên khác ví dụ như Copy of 150623.xlsx chẳng hạn
em chỉ muốn quan tâm đến 04 số cuối của file thôi số 06 là bắt buộc tìm chính xác và kế đến là 2 ký tự đại diện bất kỳ

duongdd.tp · 17/8/17

Gửi anh NDU, Em cảm ơn anh nhiều về bài viết đẫ giúp em trong công việc rất nhiều, mong anh giúp đỡ thêm được không ạ:
Khi duyệt ra file thì lưu luôn tên file vào sau cột LINK được không ạ.

trongmuaanhvancho · 23/12/17

Gửi anh NDU. Bác giúp em chỉnh sửa và thêm 1 số chức năng như dưới với ạ!
1. Cột PATH chỉ hiện theo tên file tìm kiếm được (nếu có thể cho phép người dùng có thể thêm cột vào trước hoặc sau các cột đã được thiết lập sẵn)
2. Chỉnh Font chữ vùng tự động hiện dữ liệu và font chữ toàn sheet cho cùng font
3. Ngoài vùng do addin tự động hiển thị dữ liệu người dùng có thể thêm cột mà sau mỗi lần tìm kiếm gán link ko bị mất đi (chỉ cập nhật thêm). Hiện tại chỉ cho hiển thị thông tin của lần tìm kiếm cuối cùng các dữ liệu khác đều bị xóa trắng
4. Cập nhật nhiều vùng nhiều vùng tương ứng với vùng tìm kiếm và sẽ liệt kê theo vị trí trỏ chuột
5. Khi vùng thứ nhất có thêm dữ liệu trong folder cần tìm kiếm mà không đè hay làm mất dữ liệu ở các vùng khác (Như ảnh e đang minh họa - Việc này nếu ko được người dùng có thể tự insert thêm dòng để gán lại)

dongkaka88 · 6/8/20

quá tuyệt vời, cảm ơn thầy

$||\$ $||\$ $||\$

buivantinh · 8/11/20

Các thầy ơi! Em theo cách của thầy Ndu đã lấy hết được link của các file rồi, nhưng nó không theo thứ tự tên file em lưu trong list thống kê. Có cách nào sắp xếp lại link file theo tên file không ạ? Em xin cảm ơn!

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

Người dùng đang xem chủ đề này

Huyền thoại GPE

File đính kèm

Bụi phấn

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

Thành viên gắn bó

Cánh Diều xanh

Thành viên gắn bó

Thành viên gắn bó

Cánh Diều xanh

Huyền thoại GPE

Cánh Diều xanh

Huyền thoại GPE

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

File đính kèm

Huyền thoại GPE

Cánh Diều xanh

Thành viên gắn bó

Thành viên gắn bó

Thành viên hoạt động

File đính kèm

Thành viên hoạt động

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 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

Biên Hòa, Đồng Nai

Biên Hòa, Đồng Nai

File đính kèm

Thành viên mới

Huyền thoại GPE

Thành viên mới

Thành viên mới

Thành viên hoạt động

Thành viên mới

Thành viên mới

Thời gian đếm ngược.