Quản lý tập tin bằng Excel: tìm, đổi tên, di chuyển và xóa

Hôm nay, tôi giới thiệu với các bạn ứng dụng quản lý tập tin được viết dựa trên bảng tính Excel và VBA, ứng dụng giúp dễ dàng tìm kiếm tập tin, cũng như đổi tên, di chuyển đến thư mục khác hoặc xóa tập tin rất linh hoạt.

Ứng dụng có hai hàm bổ trợ giúp liệt kê tập tin hoặc thư mục rất linh hoạt dành cho các bạn phát triển mã trong ứng dụng:
Hai hàm dưới đây sẽ giúp chúng ta thực hiện lấy tất cả File hoặc Path trong một thư mục hoặc file và các thư mục bên trong thư mục.

Hàm ListAllFiles và các tham số:
Hướng dẫn:
Thủ tục có 27 tham số :
Vì sao thủ tục lại có nhiều đối số đến vậy?, các tham số có tên ở đầu là"Return" để trả về mảng theo thuộc tính cần lấy nên khiến tham số nhiều hơn
Thuộc tính cần lấy như Cột thứ tự, tên và đuôi, chỉ có tên, kích thước tệp, thời lượng nếu là video, nhạc, đuôi tệp, kiểu tập tin, Thứ tự, đường dẫn đầy đủ, đường dẫn chứa tệp, đường dẫn lót, đường dẫn rút gọn của tệp, đường dẫn rút gọn, ngày tạo, ngày truy cập, ngày chỉnh sửa.

Vị trí
Tham số
Kiểu
Giá trị mặc định
Chức năng

1

Paths
Chuỗi hoặc mảng

Đường dẫn hoặc mảng chứa đường dẫn

2

Files()
Mảng

Trả kết quả mảng vào biến mảng

3

FSO
Đối tượng
Nothing
Nhập lớp Scripting.FileSystemObject để tiết kiệm tài nguyên hệ thống

4

IncludeSubfolders
Có/Không
Không
Kết quả bao gồm thư mục con

5

Types
Chuỗi
*
Kiểu đuôi tệp trả về kết quả

6

NameTypes
Chuỗi

Kiểu tệp nằm trong Kiểu khái quát của tệp

7

FileNameLike
Chuỗi
*
Tên tệp có chứa chuỗi nhập vào

8

FolderNameLike
Chuỗi
*
Tên folder con có chứa chuỗi nhập vào

9

RunProcedureDeleteIfWrongConditions
Chuỗi

Chuỗi tên Thủ tục thực thi để xóa tệp
Ví dụ: Sub DeleteFile()
Nhập "DeleteFile" thì thủ tục này sẽ thực thi xóa tệp

10

IsGetFileObject
Có/Không
Không
Trả về kết quả là đối tượng

11

ReturnOrder
Số nguyên
0
Trả về mảng có cột Thứ tự (Nếu lớn hơn 0, cột thứ tự thường là 1)

12

ReturnName1
Số nguyên
0
Trả về mảng có cột tên và đuôi (Nếu lớn hơn 0, nếu đặt 5 tức là cột 5 trong mảng kết quả)

13

ReturnName2
Số nguyên
0
Trả về mảng có cột chỉ có tên (Tương tự hai tham số trên)

14

ReturnSize
Số nguyên
0
Trả về mảng có cột kích thước tệp

15

ReturnLength
Số nguyên
0
Trả về mảng có cột thời lượng nếu là video, nhạc

16

ReturnExtend
Số nguyên
0
Trả về mảng có cột đuôi tệp

17

ReturnType
Số nguyên
0
Trả về mảng có cột kiểu tập tin

18

ReturnPathBetween
Số nguyên
0
Trả về mảng có cột Đường dẫn lót

19

ReturnFullPath
Số nguyên
0
Trả về mảng có cột đường dẫn đầy đủ

20

ReturnParentFolder
Số nguyên
0
Trả về mảng có cột đường dẫn chứa tệp

21

ReturnAttributes
Số nguyên
0
Trả về mảng có cột Thứ tự

22

ReturnShortName
Số nguyên
0
Trả về mảng có cột đường dẫn rút gọn của tệp

23

ReturnShortPath
Số nguyên
0
Trả về mảng có cột đường dẫn rút gọn

24

ReturnDateCreated
Số nguyên
0
Trả về mảng có cột ngày tạo

25

ReturnDateLastAccessed
Số nguyên
0
Trả về mảng có cột ngày truy cập

26

ReturnDateLastModified
Số nguyên
0
Trả về mảng có cột ngày chỉnh sửa

27

MainPath
Số nguyên

Tham số này không nhập, vì dùng cho các lần đệ quy

……………………………………………….
176
…………………………………………….

Hàm ListAllFolder và các tham số:

Vị trí
Tham số
Kiểu
Giá trị mặc định
Chức năng

1

Paths
Chuỗi hoặc mảng

Đường dẫn hoặc mảng chứa đường dẫn

2

Folders()
Mảng

Trả kết quả mảng vào biến mảng

3

FSO
Đối tượng
Nothing
Nhập lớp Scripting.FileSystemObject để tiết kiệm tài nguyên hệ thống

4

IncludeSubfolders
Có/Không
Không
Kết quả bao gồm thư mục con

5

FolderNameLike
Chuỗi
*
Tên folder con có chứa chuỗi nhập vào

6

IsGetFileObject
Có/Không
Không
Trả về kết quả là đối tượng

7

ReturnOrder
Số nguyên
0
Trả về mảng có cột Thứ tự (Nếu lớn hơn 0)

8

ReturnName
Số nguyên
0
Trả về mảng có cột tên và đuôi

9

ReturnSize
Số nguyên
0
Trả về mảng có cột chỉ có tên

10

ReturnFullPath
Số nguyên
0
Trả về mảng có cột kích thước tệp

11

ReturnParentFolder
Số nguyên
0
Trả về mảng có cột thời lượng nếu là video, nhạc

12

ReturnShortPath
Số nguyên
0
Trả về mảng có cột đường dẫn rút gọn

13

ReturnDateCreated
Số nguyên
0
Trả về mảng có cột ngày tạo

14

ReturnDateLastAccessed
Số nguyên
0
Trả về mảng có cột ngày truy cập

15

ReturnDateLastModified
Số nguyên
0
Trả về mảng có cột ngày chỉnh sửa

'                    _,
' ___   _   _  _ ___(_)
'/ __| /  | | | _ | |
'__ /  | \ | _  |
'|___/_/ _|_|_|___/_|
'
'-----------------------------------
' Lâìy danh sách têòp trong thý muòc
Sub ListAllFiles(ByVal Paths, _
                 ByRef Files(), _
        Optional ByRef FSO As Object, _
        Optional ByVal IncludeSubfolders As Boolean = False, _
        Optional ByVal Types As Variant = "*", _
        Optional ByVal NameTypes As Variant = "", _
        Optional ByVal FileNameLike As Variant = "*", _
        Optional ByVal FolderNameLike As Variant = "*", _
        Optional ByVal RunProcedureDeleteIfWrongConditions As String, _
        Optional ByVal IsGetFileObject As Boolean, _
        Optional ByVal ReturnOrder As Integer, Optional ByVal ReturnName1 As Integer, Optional ByVal ReturnName2 As Integer, _
        Optional ByVal ReturnSize As Integer, Optional ByVal ReturnLength As Integer, _
        Optional ByVal ReturnExtend As Integer, Optional ByVal ReturnType As Integer, _
        Optional ByVal ReturnPathBetween As Integer, Optional ByVal ReturnFullPath As Integer, _
        Optional ByVal ReturnParentFolder As Integer, Optional ByVal ReturnAttributes As Integer, _
        Optional ByVal ReturnShortName As Integer, Optional ByVal ReturnShortPath As Integer, _
        Optional ByVal ReturnDateCreated As Integer, _
        Optional ByVal ReturnDateLastAccessed As Integer, _
        Optional ByVal ReturnDateLastModified As Integer, _
        Optional ByVal MainPath$)
' Last Edit: 25/09/2020 08:10
  On Error Resume Next
  DoEvents
  Dim K As Long
  Dim R As Long, Cols%, C%, A(16)
  Dim Correct As Boolean
  Dim ItemName As String
  Dim ItemType As String
  Dim Ext As String
  Dim aTypes() As String
  Dim sLike() As String
  Dim Arr() As String
  Dim Folders() As String
  Dim SF
  Dim Item As Object 'Scripting.File
  Dim Folder
  Dim oFolder

'-------------------------------------------
  C = 1
  A(C) = ReturnOrder: GoSub g
  A(C) = ReturnName1: GoSub g
  A(C) = ReturnName2: GoSub g
  A(C) = ReturnSize: GoSub g
  A(C) = ReturnLength: GoSub g
  A(C) = ReturnExtend: GoSub g
  A(C) = ReturnType: GoSub g
  A(C) = ReturnPathBetween: GoSub g
  A(C) = ReturnFullPath: GoSub g
  A(C) = ReturnParentFolder: GoSub g
  A(C) = ReturnAttributes: GoSub g
  A(C) = ReturnShortName: GoSub g
  A(C) = ReturnShortPath: GoSub g
  A(C) = ReturnDateCreated: GoSub g
  A(C) = ReturnDateLastAccessed: GoSub g
  A(C) = ReturnDateLastModified: GoSub g

'-------------------------------------------
  If VBA.TypeName(Paths) = "String" Then Paths = Array(Paths)
  If MainPath = vbNullString Then MainPath = Paths(0)
  '-------------------------------------------
  If VBA.TypeName(FileNameLike) = "String" Then
    If FileNameLike <> vbNullString Then
      Arr = VBA.Split(FileNameLike, "|")
      ReDim sLike(UBound(Arr))
      If VBA.Err = 0 Then
        For R = LBound(Arr) To UBound(Arr)
          sLike(R) = "*" & VBA.LCase(Arr(R)) & "*"
        Next R
      End If
    End If
  Else
    ReDim sLike(UBound(FileNameLike))
    If VBA.Err = 0 Then
      For R = LBound(FileNameLike) To UBound(FileNameLike)
        sLike(R) = "*" & VBA.LCase(FileNameLike(R)) & "*"
      Next R
    End If
  End If  '-------------------------------------------
  R = 0
  VBA.Err.clear
  If VBA.TypeName(NameTypes) = "String" Then
    If NameTypes <> vbNullString Then
      Arr = VBA.Split(NameTypes, ",")
      ReDim aTypes(UBound(Arr))
      If VBA.Err = 0 Then
        For R = LBound(Arr) To UBound(Arr)
          aTypes(R) = VBA.Trim(VBA.LCase(Arr(R)))
        Next R
      End If
    End If
  Else
    ReDim aTypes(UBound(NameTypes))
    If VBA.Err = 0 Then
      For R = LBound(NameTypes) To UBound(NameTypes)
        aTypes(R) = VBA.Trim(VBA.LCase(NameTypes(R)))
      Next R
    End If
  End If
  VBA.Err.clear
  '-------------------------------------------
  If VBA.TypeName(Types) = "String" Then
    If Types <> vbNullString Then
      Arr = VBA.Split(Types, ",")
      ReDim Preserve aTypes(R + UBound(Arr))
      If VBA.Err = 0 Then
        For R = LBound(Arr) To UBound(Arr)
          aTypes(R) = VBA.Trim(VBA.LCase(Arr(R)))
          If Not aTypes(R) Like "[*]*" Then
            aTypes(R) = "*" & aTypes(R)
          End If
        Next R
      End If
    End If
  Else
    ReDim aTypes(UBound(Types) + VBA.IIf(R = -1, 0, R))
    If VBA.Err = 0 Then
      For K = LBound(Types) To UBound(Types)
        If Not Types(K) Like "[*]*" Then
          aTypes(K + VBA.IIf(R = -1, 0, R)) = "*" & VBA.LCase(Types(K))
        Else
          aTypes(K + VBA.IIf(R = -1, 0, R)) = VBA.LCase(Types(K))
        End If
      Next K
    End If
  End If
  '-------------------------------------------
  If FSO Is Nothing Then Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
  '-------------------------------------------
  R = 0
  R = UBound(Files, 2)
  For Each Folder In Paths
    If FSO.FolderExists(Folder) Then
      Set oFolder = FSO.GetFolder(Folder)
        For Each Item In oFolder.Files
          ItemName = vbNullString: ItemName = VBA.LCase(Item.Name)
          Ext = VBA.LCase(VBA.Trim(VBA.RIGHT(VBA.Replace(ItemName, ".", VBA.Space(255)), 255)))
          ItemName = VBA.LEFT(ItemName, Len(ItemName) - Len(Ext) - 1)
          ItemType = vbNullString: ItemType = VBA.LCase(Item.Type)
          Correct = False
          For Each SF In aTypes
            If VBA.LEFT(ItemName, 1) <> "~" And ("." & Ext Like SF Or ItemType = SF) Then
              Correct = True: Exit For
            End If
          Next SF
          If Correct And FileNameLike <> "*" And FileNameLike <> "" Then
            For Each SF In sLike
              If ItemName Like SF Then Correct = True: GoTo GetItem
            Next SF
            Correct = False
          End If
GetItem:
          If Correct Then
            R = R + 1
            If Not IsGetFileObject Then
              ReDim Preserve Files(1 To Cols, 1 To R)
              With Item
                C = 1: If A(C) > 0 Then Files(A(C), R) = R
                C = C + 1: If A(C) > 0 Then Files(A(C), R) = .Name
                C = C + 1: If A(C) > 0 Then Files(A(C), R) = VBA.LEFT(.Name, Len(.Name) - Len(Ext) - 1)
                C = C + 1: If A(C) > 0 Then Files(A(C), R) = VBA.Round(.Size / 1024 / 1024, 2)
                C = C + 1
                If A(C) > 0 Then
                  Static Sh As Object
                  If Sh Is Nothing Then Set Sh = VBA.CreateObject("Shell.Application")
                  Dim ShFolder As Object, ParseName As Object, tTime As String
                  Set ShFolder = Sh.Namespace(CVar(.ParentFolder & ""))
                  Set ParseName = ShFolder.ParseName(.Name)
                  If Not ParseName Is Nothing Then _
                  Files(A(C), R) = ShFolder.GetDetailsOf(ShFolder.ParseName(.Name), 27)
                  Set ParseName = Nothing
                End If
                C = C + 1: If A(C) > 0 Then Files(A(C), R) = Ext
                C = C + 1: If A(C) > 0 Then Files(A(C), R) = .Type
                C = C + 1
                If A(C) > 0 Then
                  Files(A(C), R) = Replace(.path, MainPath, "", , , 1)
                  Files(A(C), R) = Replace(Files(A(C), R), .Name, "", , , 1)
                End If
                C = C + 1: If A(C) > 0 Then Files(A(C), R) = .path
                C = C + 1: If A(C) > 0 Then Files(A(C), R) = .ParentFolder
                C = C + 1: If A(C) > 0 Then Files(A(C), R) = .Attributes
                C = C + 1: If A(C) > 0 Then Files(A(C), R) = .ShortName
                C = C + 1: If A(C) > 0 Then Files(A(C), R) = .ShortPath
                C = C + 1: If A(C) > 0 Then Files(A(C), R) = CDate(.DateCreated)
                C = C + 1: If A(C) > 0 Then Files(A(C), R) = CDate(.DateLastAccessed)
                C = C + 1: If A(C) > 0 Then Files(A(C), R) = CDate(.DateLastModified)
              End With
            Else
              ReDim Preserve Files(1 To R)
              Set Files(R) = Item
            End If
          Else
            If RunProcedureDeleteIfWrongConditions <> "" Then
              Application.Run RunProcedureDeleteIfWrongConditions, Item.path
            End If
          End If
        Next Item
CheckSub:
      If IncludeSubfolders Then
        For Each SF In oFolder.SubFolders
          If VBA.LCase(SF.Name) Like VBA.LCase(FolderNameLike) Then
            K = K + 1: ReDim Preserve Folders(1 To K): Folders(K) = SF.path
          End If
        Next SF
      End If
    End If
  Next Folder
  If IncludeSubfolders And K > 0 Then
    Call ListAllFiles(Folders, Files, FSO, True, Types, NameTypes, _
                      FileNameLike, FolderNameLike, RunProcedureDeleteIfWrongConditions, _
                      IsGetFileObject, _
                      ReturnOrder, ReturnName1, ReturnName2, ReturnSize, ReturnLength, ReturnExtend, ReturnType, _
                      ReturnPathBetween, ReturnFullPath, ReturnParentFolder, _
                      ReturnAttributes, ReturnShortName, ReturnShortPath, _
                      ReturnDateCreated, ReturnDateLastAccessed, ReturnDateLastModified, MainPath)
  End If
On Error GoTo 0
Exit Sub
g:
  If A(C) > Cols Then Cols = A(C)
  C = C + 1
Return
End Sub
'                    _,
' ___   _   _  _ ___(_)
'/ __| /  | | | _ | |
'__ /  | \ | _  |
'|___/_/ _|_|_|___/_|
'
Sub ListAllFolder(ByVal Paths, _
                 ByRef Folders(), _
        Optional ByRef FSO As Object, _
        Optional ByVal IncludeSubfolders As Boolean = False, _
        Optional ByVal FolderNameLike = "*", _
        Optional ByVal IsGetFileObject As Boolean, _
        Optional ByVal ReturnOrder As Integer, _
        Optional ByVal ReturnName As Integer, _
        Optional ByVal ReturnSize As Integer, _
        Optional ByVal ReturnFullPath As Integer, _
        Optional ByVal ReturnParentFolder As Integer, _
        Optional ByVal ReturnShortPath As Integer, _
        Optional ByVal ReturnDateCreated As Integer, _
        Optional ByVal ReturnDateLastAccessed As Integer, _
        Optional ByVal ReturnDateLastModified As Integer)

Dim R&, C%, K&, LB%, UB&, Arr(), dArr(), Folder, Cols%, A(9)
  Dim Item As Object 'Scripting.Folder
  Dim oFolder As Object  ''Scripting.Folder
  '-------------------------------------------
  C = 1
  A(C) = ReturnOrder: GoSub g
  A(C) = ReturnName: GoSub g
  A(C) = ReturnSize: GoSub g
  A(C) = ReturnFullPath: GoSub g
  A(C) = ReturnParentFolder: GoSub g
  A(C) = ReturnShortPath: GoSub g
  A(C) = ReturnDateCreated: GoSub g
  A(C) = ReturnDateLastAccessed: GoSub g
  A(C) = ReturnDateLastModified: GoSub g

If VBA.TypeName(Paths) = "String" Then Paths = Array(Paths)

If FSO Is Nothing Then
    Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
  End If
  On Error Resume Next
  R = UBound(Folders)
  For Each Folder In Paths
    If FSO.FolderExists(Folder) Then
      Set oFolder = FSO.GetFolder(Folder)
      For Each Item In oFolder.SubFolders
        K = K + 1: ReDim Preserve dArr(1 To K)
        dArr(K) = Item.path
        R = R + 1
        If Not IsGetFileObject Then
          ReDim Preserve Folders(1 To Cols, 1 To R)
          C = 0
          With Item
            C = 1
            If A(C) > 0 Then: Folders(A(C), R) = R
            C = C + 1
            If A(C) > 0 Then: Folders(A(C), R) = .Name
            C = C + 1
            If A(C) > 0 Then: Folders(A(C), R) = VBA.Round(.Size / 1024 / 1024, 2)
            C = C + 1
            If A(C) > 0 Then: Folders(A(C), R) = .path
            C = C + 1
            If A(C) > 0 Then: Folders(A(C), R) = .ParentFolder
            C = C + 1
            If A(C) > 0 Then: Folders(A(C), R) = .ShortPath
            C = C + 1
            If A(C) > 0 Then: Folders(A(C), R) = .DateCreated
            C = C + 1
            If A(C) > 0 Then: Folders(A(C), R) = .DateLastAccessed
            C = C + 1
            If A(C) > 0 Then: Folders(A(C), R) = .DateLastModified
          End With
        Else
          ReDim Preserve Folders(1 To R)
          Set Folders(R) = Item
        End If
      Next Item
    End If
  Next Folder
  If K > 0 And IncludeSubfolders Then
    Call ListAllFolder(dArr, Folders, FSO, True, FolderNameLike, _
                        ReturnOrder, ReturnName, ReturnSize, _
                        ReturnFullPath, ReturnParentFolder, ReturnShortPath, _
                        ReturnDateCreated, ReturnDateLastAccessed, ReturnDateLastModified)
  End If
Exit Sub
g:
  If Cols < A(C) Then Cols = A(C)
  C = C + 1
Return
End Sub

File ứng dụng:

www.giaiphapexcel.com/diendan/threads/qu%E1%BA%A3n-l%C3%BD-t%E1%BA%ADp-tin-b%E1%BA%B1ng-excel-t%C3%ACm-%C4%91%E1%BB%95i-t%C3%AAn-di-chuy%E1%BB%83n-v%C3%A0-x%C3%B3a.145043/

Khóa học SprinGO phù hợp

Khóa học Power PI – Ứng dung trong Nhân sự

TỔNG QUAN KHÓA HỌC: POWER BI CHO NGÀNH NHÂN SỰ Khóa học Power BI cho Nhân sự được thiết kế dành riêng cho các...

Xem khóa học