Excel vba:Tạo bảng quản lý files trong folder cho excel version không hỗ trợ power query

 

Mở file excel, tạo template với hàng cột như hình

chạy sub sau:

Sub ListFilesInFolders()

    Dim ws As Worksheet

    Dim FolderPath As String

    Dim FilePath As String

    Dim FileName As String

    Dim LastRow As Long

    Dim FSO As Object

    Dim Folder As Object

    Dim SubFolder As Object

    Dim File As Object

    

    FolderPath = "D:\THANH\project" 'change this path to your folder

    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"

    Set ws = ActiveSheet

    ws.Rows("4:" & ws.Rows.Count).Clear

    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set Folder = FSO.GetFolder(FolderPath)

    LastRow = 4

    Call ListFiles(Folder, ws, LastRow)

    MsgBox "File list updated successfully!", vbInformation

End Sub

Sub ListFiles(Folder As Object, ws As Worksheet, ByRef LastRow As Long)

    Dim SubFolder As Object

    Dim File As Object

    Dim FileType As String

    

    For Each File In Folder.Files

        If (File.Attributes And 16) = 0 Then 

            FileType = Mid(File.Name, InStrRev(File.Name, "."))

            ws.Cells(LastRow, 1).Value = Folder.Path ' Folder Path

            ws.Cells(LastRow, 2).Value = File.Name ' File Name

            ws.Cells(LastRow, 3).Value = FileType ' Type

            ws.Cells(LastRow, 4).Value = File.DateCreated ' Create Date

            ws.Cells(LastRow, 5).Value = File.DateLastModified ' Modified Date

            ws.Cells(LastRow, 6).Value = Round(File.Size / 1024, 2) ' File Size (KB)

            ws.Cells(LastRow, 7).Hyperlinks.Add Anchor:=ws.Cells(LastRow, 7), Address:=File.Path, TextToDisplay:="File Link" ' File Path (Hyperlink)

            ws.Cells(LastRow, 8).Hyperlinks.Add Anchor:=ws.Cells(LastRow, 8), Address:=Folder.Path, TextToDisplay:="Folder Link" ' Folder Path (Hyperlink)

            

            LastRow = LastRow + 1

        End If

    Next File

    For Each SubFolder In Folder.SubFolders

        Call ListFiles(SubFolder, ws, LastRow)

    Next SubFolder

End Sub