列出Excel中文件夹和子文件夹中的所有文件

I need to list all files and folders in a network and hence require a faster and better VBA directory lister.

我需要列出网络中的所有文件和文件夹,因此需要更快更好的VBA目录列表器。

This question is asked in many forums and also here as in the below links:

这个问题在许多论坛中都有提问,也在下面的链接中提出:

Loop through files in a folder using VBA?

使用VBA循环浏览文件夹中的文件?

Get list of sub-directories in VBA

获取VBA中的子目录列表

List files in folder and subfolder with path to .txt file

列出文件夹和子文件夹中的文件以及.txt文件的路径

I have used some and modified the code from here:

我已经使用了一些并修改了这里的代码:

http://www.mrexcel.com/forum/excel-questions/56980-file-listing-all-files-including-subfolders-2.html and is given below.

http://www.mrexcel.com/forum/excel-questions/56980-file-listing-all-files-including-subfolders-2.html,如下所示。

'Force the explicit declaration of variables
 Option Explicit

 Sub ListFiles()
'Set a reference to Microsoft Scripting Runtime by using
'Tools > References in the Visual Basic Editor (Alt+F11)

'Declare the variables
 Dim objFSO As Scripting.FileSystemObject
 Dim objTopFolder As Scripting.Folder
 Dim strTopFolderName As String
 Dim n As Long
 Dim Msg As Byte
 Dim Drilldown As Boolean


 'Assign the top folder to a variable
 With Application.FileDialog(msoFileDialogFolderPicker)
 .AllowMultiSelect = False
 .Title = "Pick a folder"
 .Show
 If .SelectedItems.Count = 0 Then MsgBox "Operation Cancelled by the user",     vbExclamation + vbOKOnly, "List Files": Exit Sub
strTopFolderName = .SelectedItems(1)

    Msg = MsgBox("Do you want to list all files in descendant folders,  too?", _
    vbInformation + vbYesNo, "Drill-Down")
    If Msg = vbYes Then Drilldown = True Else Drilldown = False
  End With

' create a new sheet
 If Len(Mid$(strTopFolderName, InStrRev(strTopFolderName, "\") + 1)) < 31    Then
 ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name =    Mid$(strTopFolderName, InStrRev(strTopFolderName, "\") + 1)
Else: ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name =   Left(Mid$(strTopFolderName, InStrRev(strTopFolderName, "\") + 1), 31)
End If
'Insert the headers for Columns A through F
Range("A1").Value = "File Name"
Range("B1").Value = "Ext"
Range("C1").Value = "File Name"
Range("D1").Value = "File Size"
Range("E1").Value = "File Type"
Range("F1").Value = "Date Created"
Range("G1").Value = "Date Last Accessed"
Range("H1").Value = "Date Last Modified"
Range("I1").Value = "File Path"


'Create an instance of the FileSystemObject
 Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the top folder
 Set objTopFolder = objFSO.GetFolder(strTopFolderName)

'Call the RecursiveFolder routine
 Call RecursiveFolder(objTopFolder, Drilldown)

'Change the width of the columns to achieve the best fit
'Columns.AutoFit

'ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes).TableStyle = "TableStyleLight1"
MsgBox ("Done")
ActiveWorkbook.Save
Sheet1.Activate
End Sub

Sub RecursiveFolder(objFolder As Scripting.Folder, _
IncludeSubFolders As Boolean)

'Declare the variables
 Dim objFile As Scripting.File
 Dim objSubFolder As Scripting.Folder
 Dim NextRow As Long
 Dim strTopFolderName As String
 Dim n As Long
 Dim maxRows As Long
 Dim sheetNumber As Integer
 maxRows = 1048576

'Find the next available row
 NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1

'Loop through each file in the folder
 For Each objFile In objFolder.Files
    'to take complete filename in column C  and extract filename without  extension lso allowing for fullstops in filename itself
    Cells(NextRow, "A") =    "=LEFT(RC[+2],FIND(""#"",SUBSTITUTE(RC[+2],""."",""#"",LEN(RC[+2])- LEN(SUBSTITUTE(RC[+2],""."",""""))))-1)"


    'to take complete filename from row C and show only its extension
    Cells(NextRow, "B") = "=TRIM(RIGHT(SUBSTITUTE(RC[+1],""."",REPT(""  "",LEN(RC[+1]))),LEN(RC[+1])))"


    Cells(NextRow, "C").Value = objFile.Name
    Cells(NextRow, "D").Value = Format((objFile.Size / 1024), "000") & " KB"
    Cells(NextRow, "E").Value = objFile.Type
    Cells(NextRow, "F").Value = objFile.DateCreated
    Cells(NextRow, "G").Value = objFile.DateLastAccessed
    Cells(NextRow, "H").Value = objFile.DateLastModified
    Cells(NextRow, "I").Value = objFile.Path



    NextRow = NextRow + 1
Next objFile

' If "descendant" folders also get their files listed, then sub calls itself recursively

 If IncludeSubFolders Then
    For Each objSubFolder In objFolder.SubFolders
        Call RecursiveFolder(objSubFolder, True)
    Next objSubFolder
End If

'Loop through files in the subfolders

'If IncludeSubFolders Then
 '   For Each objSubFolder In objFolder.SubFolders
  '  If Msg = vbYes Then Drilldown = True Else Drilldown = False
   '     Call RecursiveFolder(objSubFolder, True)
    'Next objSubFolder
'End If

 If n = maxRows Then
 sheetNumber = sheetNumber + 1
 ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
 'ActiveSheet.Name = "Sheet-" & sheetNumber
 ActiveSheet.Name = strTopFolderName & "_" & sheetNumber
 n = 0
 End If
 n = n + 1
 End Sub

and another one is using Dir again from that site

另一个是从该网站再次使用Dir

http://www.mrexcel.com/forum/excel-questions/656026-better-way-listing-folders-subfolders-contents.html

Sub ListFiles()
Const sRoot     As String = "C:\"
Dim t As Date

Application.ScreenUpdating = False
With Columns("A:C")
    .ClearContents
    .Rows(1).Value = Split("File,Date,Size", ",")
End With

t = Timer
NoCursing sRoot
Columns.AutoFit
Application.ScreenUpdating = True
MsgBox Format(Timer - t, "0.0s")
End Sub

Sub NoCursing(ByVal sPath As String)
Const iAttr     As Long = vbNormal + vbReadOnly + _
      vbHidden + vbSystem + _
      vbDirectory
Dim col         As Collection
Dim iRow        As Long
Dim jAttr       As Long
Dim sFile       As String
Dim sName       As String

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

Set col = New Collection
col.Add sPath

iRow = 1

Do While col.Count
    sPath = col(1)

    sFile = Dir(sPath, iAttr)

    Do While Len(sFile)
        sName = sPath & sFile

        On Error Resume Next
        jAttr = GetAttr(sName)
        If Err.Number Then
            Debug.Print sName
            Err.Clear

        Else
            If jAttr And vbDirectory Then
                If Right(sName, 1) <> "." Then col.Add sName & "\"
            Else
                iRow = iRow + 1
                If (iRow And &H3FF) = 0 Then Debug.Print iRow
                Rows(iRow).Range("A1:C1").Value = Array(sName, _
                                                        FileLen(sName), _
                                                        FileDateTime(sName))
            End If
        End If
        sFile = Dir()
    Loop
    col.Remove 1
Loop
End Sub

The speed with FilesystemObject is slower compared to dir.

与dir相比,FilesystemObject的速度较慢。

So, my question is :

所以,我的问题是:

How to modify 2nd code to first format using Dir, to include the attributes "FileName (as Formula), Date Created, Date Last Accessed, Date Last Modified" in the code. (Code gives "FileDateTime(sName)" date & time but I require these as in the previous code.)

如何使用Dir将第二个代码修改为第一个格式,以在代码中包含属性“FileName(作为公式),创建日期,上次访问日期,上次修改日期”。 (代码给出“FileDateTime(sName)”日期和时间,但我需要这些,如上一代码所示。)

Also If the list exceeds the row limit, code should create another sheet with folder name-2 etc, and continue from where it ended.

此外,如果列表超出行限制,代码应创建另一个具有文件夹名称-2等的工作表,并从它结束的位置继续。

Secondly I need it to take multiple folder paths from another sheet range like Sheet1.Range("A2").End(Xlup) and not using filedialog or hardcoded, create folder tabs and run the code taking one folder path at a time.

其次我需要从另一个工作表范围中取出多个文件夹路径,如Sheet1.Range(“A2”)。End(Xlup)并且不使用filedialog或硬编码,创建文件夹选项卡并运行代码一次获取一个文件夹路径。

7 个解决方案

#1

Convert all Long and Integer data types to CLngPtr(variable)

将所有Long和Integer数据类型转换为CLngPtr(变量)

Add Application.ScreenUpdating = False just after Sub line.

在Sub line之后添加Application.ScreenUpdating = False。

Add Application.ScreenUpdating = True just before the End Sub line.

在End Sub行之前添加Application.ScreenUpdating = True。

#2

'========================================== 'Open File

'=========================================='打开文件

Sub Open_File()
Const MARU = "MARU"
Const BATSU = "BATSU"
Const BAR = "BAR"
Const PHANTU = 10
Dim path As String
Dim number(PHANTU) As String
Dim comment(PHANTU) As String
' Get Number Comment
'For index_path = 1 To 5
Sheets(3).Activate
path = Cells(7, 1)
If path <> "" Then
Call GetNumCom(path, number, comment)
MsgBox ("Number1:" & number(1))
MsgBox ("Number10:" & number(10))
Else
index_path = 100
End If
'Next index_path
'Fill in Result
For i = 6 To 20
Sheets(1).Activate
If Cells(i, 4) = BATSU Then
MsgBox ("Name book:" & ActiveWorkbook.Name & "Name sheet:" & ActiveSheet.Name)
    For arr_index = 1 To PHANTU
        If Cells(i, 3) = number(arr_index) Then
            Cells(i, 5) = comment(arr_index)
        End If
    Next
End If
Next i
'Close Path
End Sub
'==========================================
'Get Number() Comment
Sub GetNumCom(path As String, number() As String, comment() As String)
Workbooks.Open path
For i = 1 To 10
number(i) = Cells(i, 1).value
comment(i) = Cells(i, 3).value
Next i
ActiveWindow.Close
End Sub

#3

'MODULE 2
'TAT CA HAM CON DUOC GOI CHO HAM CHINH
'*****************************************************************************'
'01: Clear_Array(name_array, index_array)                           **********'
'02: Getdata_Row_Array(array_data, row_data, col_start, col_end)    **********'
'03: Cut_String(text_cut(), text_condition, data_ouput()())         **********'
'04: Filldata_IO(array_data(), row_start, size)                     **********'
'05: Fill_Number_IO(row_start, col_start, size)                     **********'
'*****************************************************************************'


'====================================================================
'STT: 01                                                            =
'Ten Ham: Clear_Array(name_array, index_array)                      =
'Chuc nang: Xoa all phan tu mang ve ""                              =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/20                                               =
'====================================================================
Public Sub Clear_Array(name_array() As String, INDEX_ARRAY As Integer)
    For i = 1 To INDEX_ARRAY
        name_array(i) = ""
    Next i
End Sub

'====================================================================
'STT: 02                                                            =
'Ten Ham: Getdata_Row_Array(array_data, row_data, col_start, col_end)=
'Chuc nang: Lay du lieu vao mang tu hang va cot da chi dinh         =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/20                                               =
'====================================================================
Public Sub Getdata_Row_Array(array_data() As String, ByVal row_data As Integer, ByVal col_start As Integer, ByVal col_end As Integer)
    For i = 1 To (col_end - col_start + 1)
        array_data(i) = Cells(row_data, col_start + (i - 1)).Value
    Next i
End Sub

'====================================================================
'STT: 03                                                            =
'Ten Ham: Cut_String(text_cut(), text_condition, data_ouput()())    =
'Chuc nang: Cat chuoi lam 2 tu text chi dinh dua vao mang           =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/21                                               =
'====================================================================
Public Sub Cut_String(text_cut() As String, TEXT_CONDITION As String, data_ouput() As String)
    Dim position_find As Integer
    For i = 1 To Size_Array(text_cut())
        position_find = InStr(text_cut(i), TEXT_CONDITION)
        If position_find <> 0 Then
            data_ouput(i, 1) = Left(text_cut(i), position_find - 1)
            data_ouput(i, 2) = Right(text_cut(i), Len(text_cut(i)) - position_find)
        Else
            data_ouput(i, 1) = text_cut(i)
            data_ouput(i, 2) = ""
        End If
    Next i
End Sub

'====================================================================
'STT: 04                                                            =
'Ten Ham: Filldata_IO(array_data(), row_start, size)                =
'Chuc nang: Dien du lieu vao vung input output                      =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/21                                               =
'====================================================================
Public Sub Filldata_IO(array_data() As String, row_start As Integer, size As Integer)
    Const COL_NUMBER = 2
    Const COL_RET = 5
    Const COL_ARG = 8

    'Chi so mang array_data
    Dim index As Integer
    index = 1

    For i = row_start To (row_start + size - 1)
        Cells(i, COL_NUMBER).Value = index
        Cells(i, COL_RET).Value = array_data(index, 1)
        Cells(i, COL_ARG).Value = array_data(index, 2)
        index = index + 1
    Next i
End Sub

'====================================================================
'STT: 05                                                            =
'Ten Ham: Fill_Number_IO(row_start, col_start, size)                =
'Chuc nang: Dien so vao vung testcase data                          =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/21                                               =
'====================================================================
Public Sub Fill_Number_IO(row_start As Integer, col_start As Integer, size As Integer)
    For i = 1 To size
        Cells(row_start, col_start + i - 1).Value = i
    Next i
End Sub

#4

'MODULE 3
'THU VIEN CHO TAT CA CAC HAM DUNG
'*******************************************************************'
'01: Search_Cell_Last(row_cell_last,col_cell_last)                  '
'02: Search_String(text_find, row_find, col_find)                   '
'03: Insert_Row(row_copy,size_row)                                  '
'04: Insert_Range(row_start,col_start,row_end,col_end,size_range)   '
'05: Size_Array(array_exe)                                          '
'06: Clear_Array_2(array_exe())                                     '
'07: Show_Array(array_data(),size)                                  '
'08: Copy_Range(row_start, col_start, row_end, col_end)             '
'09: Paste_Range_Insert(row_seclect, col_select)                    '
'*******************************************************************'




'====================================================================
'STT: 01                                                            =
'Ten Ham: Search_Cell_Last(row_cell_last,col_cell_last)             =
'Chuc nang: Tim o cuoi cung trong mot sheet tra ve han va cot       =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/20                                               =
'====================================================================
Public Sub Search_Cell_Last(row_cell_last As Integer, col_cell_last As Integer)
    row_cell_last = ActiveCell.SpecialCells(xlLastCell).Row
    col_cell_last = ActiveCell.SpecialCells(xlLastCell).Column
End Sub

'====================================================================
'STT: 02                                                            =
'Ten Ham: Search_String(text_find, row_find, col_find)              =
'Chuc nang: Tim chuoi va tra ve cot va hang o tim duoc              =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/20                                               =
'====================================================================
Public Sub Search_String(ByVal text_find As String, row_find As Integer, col_find As Integer)
    Dim row_cell_last As Integer
    Dim col_cell_last As Integer

    Call Search_Cell_Last(row_cell_last, col_cell_last)

    For row_cell = 1 To row_cell_last
        For col_cell = 1 To col_cell_last
            If Cells(row_cell, col_cell).Value = text_find Then
               row_find = row_cell
               col_find = col_cell
               Exit Sub
            End If
        Next col_cell
    Next row_cell
    row_find = 0
    col_find = 0
End Sub

'====================================================================
'STT: 03                                                            =
'Ten Ham: Insert_Row(row_copy,size_row)                             =
'Chuc nang: Chon hang copy va insert xuong phia duoi voi kich thuoc size=
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/20                                               =
'====================================================================
Public Sub Insert_Row(row_copy As Integer, size_row As Integer)
    For i = 1 To size_row
        Rows(row_copy).Copy
        Rows(row_copy).Insert Shift:=xlDown
    Next i
End Sub

'====================================================================
'STT: 04                                                            =
'Ten Ham: Insert_Range(row_start,col_start,row_end,col_end,size_range)=
'Chuc nang: Chen range voi kich thuoc size                          =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/20                                               =
'====================================================================
Public Sub Insert_Range(row_start As Integer, col_start As Integer, row_end As Integer, col_end As Integer, size_range As Integer)
    For i = 1 To size_range
        Range(Cells(row_start, col_start), Cells(row_end, col_end)).Insert Shift:=xlToRight
    Next i
End Sub

'====================================================================
'STT: 05                                                            =
'Ten Ham: Size_Array(array_exe)                                     =
'Chuc nang: Xuat ra kich thuoc mang chua du lieu                    =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/20                                               =
'====================================================================
Public Function Size_Array(array_exe() As String) As Integer
    For i = 1 To UBound(array_exe, 1)
        If array_exe(i) = "" Then
            Size_Array = i - 1
            Exit Function
        End If
    Next i
    Size_Array = UBound(array_exe, 1)
End Function

'====================================================================
'STT: 06                                                            =
'Ten Ham: Clear_Array_2(array_exe())                                =
'Chuc nang: Xoa mang 2 chieu ve ""                                =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/20                                               =
'====================================================================
Public Sub Clear_Array_2(array_2() As String)
    For i = 1 To UBound(array_2, 1)
        array_2(i, 1) = ""
        array_2(i, 2) = ""
    Next i
End Sub

'====================================================================
'STT: 07                                                            =
'Ten Ham: Show_Array(array_data(),size)                             =
'Chuc nang: Hien thi mang 1 chieu                                   =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/21                                               =
'====================================================================
Public Sub Show_Array(array_data() As String, size As String)
    For i = 1 To size
        Debug.Print (array_data(i))
    Next i
End Sub

'====================================================================
'STT: 08                                                            =
'Ten Ham: Copy_Range(row_start, col_start, row_end, col_end)        =
'Chuc nang: Copy vung du lieu                                       =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/22                                               =
'====================================================================
Public Sub Copy_Range(row_start As Integer, col_start As Integer, row_end As Integer, col_end As Integer)
    Range(Cells(row_start, col_start), Cells(row_end, col_end)).Copy
End Sub

'====================================================================
'STT: 09                                                            =
'Ten Ham: Paste_Range_Insert(row_seclect, col_select)               =
'Chuc nang: Dan vung du lieu kieu insert xuong                      =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/22                                               =
'====================================================================
Public Sub Paste_Range_Insert(row_seclect As Integer, col_select As Integer)
    Cells(row_seclect, col_select).Insert Shift:=xlDown
End Sub

#5

'MODULE 1
'====================================================================
'STT: 11                                                            =
'Ten Ham: Delete_Row(row_delete)                                    =
'Chuc nang: Xoa mot hang duoc chi dinh voi kich thuoc cho truoc     =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/23                                               =
'====================================================================
Public Sub Delete_Row(row_delete As Integer)
    Rows(row_delete).Delete Shift:=xlUp
End Sub

'====================================================================
'STT: 12                                                            =
'Ten Ham: Sum_Range(row_start,col_start,row_end,col_end)            =
'Chuc nang: Tinh tong cac so trong mot vung                         =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/23                                               =
'====================================================================
Public Function Sum_Range(row_start As Integer, col_start As Integer, row_end As Integer, col_end As Integer) As Integer

    Dim sum_temp As Integer
    sum_temp = 0

    For row_active = row_start To row_end
        For col_active = col_start To col_end
            If IsNumeric(Cells(row_active, col_active)) Then
                sum_temp = sum_temp + Cells(row_active, col_active)
            Else
                MsgBox ("SUM_RANGE: Trong vung tinh tong co du lieu khong phai so.")
                Sum_Range = 0
                Exit Function
            End If
        Next col_active
    Next row_active
    Sum_Range = sum_temp
End Function

#6

'MODULE 3
'====================================================================
'STT: 10                                                            =
'Ten Ham: Search_Celllast_Data(row_find, col_find)                  =
'Chuc nang: Tim kiem o cuoi cung co du lieu trong Sheet             =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/23                                               =
'====================================================================
Public Sub Search_Celllast_Data(row_find As Integer, col_find As Integer)
    Dim row_last As Integer
    Dim col_last As Integer

    row_find = 0
    col_find = 0
    'Lay vi tri o cuoi cung trong sheet
    Call Search_Cell_Last(row_last, col_last)

    'Lay ra o cuoi cung co du lieu
    For row_active = 1 To row_last
        For col_active = 1 To col_last
            If Cells(row_active, col_active) <> "" Then
                'Lay hang lon nhat co chua du lieu
                row_find = row_active
                'Lay cot lon nhat co chua du lieu
                If col_find < col_active Then
                    col_find = col_active
                End If
            End If
        Next col_active
    Next row_active
End Sub

'====================================================================
'STT: 11                                                            =
'Ten Ham: Delete_Row(row_delete)                                    =
'Chuc nang: Xoa mot hang duoc chi dinh voi kich thuoc cho truoc     =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/23                                               =
'====================================================================
Public Sub Delete_Row(row_delete As Integer)
    Rows(row_delete).Delete Shift:=xlUp
End Sub

'====================================================================
'STT: 12                                                            =
'Ten Ham: Sum_Range(row_start,col_start,row_end,col_end)            =
'Chuc nang: Tinh tong cac so trong mot vung                         =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/23                                               =
'====================================================================
Public Function Sum_Range(row_start As Integer, col_start As Integer, row_end As Integer, col_end As Integer) As Integer

    Dim sum_temp As Integer
    sum_temp = 0

    For row_active = row_start To row_end
        For col_active = col_start To col_end
            If IsNumeric(Cells(row_active, col_active)) Then
                sum_temp = sum_temp + Cells(row_active, col_active)
            Else
                MsgBox ("SUM_RANGE: Trong vung tinh tong co du lieu khong phai so.")
                Sum_Range = 0
                Exit Function
            End If
        Next col_active
    Next row_active
    Sum_Range = sum_temp
End Function

'====================================================================
'STT: 13                                                            =
'Ten Ham: Open_File(path_file)                                      =
'Chuc nang: Mo file bang path                                       =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/24                                               =
'====================================================================
Public Sub Open_File(path_file As String)
    Workbooks.Open Filename:=path_file
End Sub

'====================================================================
'STT: 14                                                            =
'Ten Ham: Close_File(file_name)                                     =
'Chuc nang: Dong file bang ten                                      =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/24                                               =
'====================================================================
Public Sub Close_File(file_name As String)
    Windows(file_name).Activate
    ActiveWindow.Close
End Sub

'====================================================================
'STT: 15                                                            =
'Ten Ham: Save_File(file_name)                                      =
'Chuc nang: Luu file bang ten                                       =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/24                                               =
'====================================================================
Public Sub Save_File(file_name As String)
    ActiveWorkbook.Save
End Sub

'====================================================================
'STT: 16                                                            =
'Ten Ham: Get_Name_Workbook(number_workbook)                        =
'Chuc nang: Lay ten cua Workbook dua vao so stt                     =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/24                                               =
'====================================================================
Public Function Get_Name_Workbook(number_workbook As Integer) As String
    Get_Name_Workbook = Workbooks(number_workbook).Name
End Function

'====================================================================
'STT: 17                                                            =
'Ten Ham: Get_Name_Worksheet(number_worksheet)                      =
'Chuc nang: Lay ten cua Worksheet dua vao so stt                    =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/24                                               =
'====================================================================
Public Function Get_Name_Worksheet(number_worksheet As Integer) As String
    If number_worksheet <= Sheets.Count Then
        Get_Name_Worksheet = Worksheets(number_worksheet).Name
    Else
        MsgBox ("Thu tu sheet da vuot qua tong so sheets.")
    End If

End Function

'====================================================================
'STT: 18                                                            =
'Ten Ham: Copy_Sheet(name_sheet_copy, location_insert)              =
'Chuc nang: Copy sheet moi vao vi tri chi dinh                      =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/24                                               =
'====================================================================
Public Sub Copy_Sheet(name_sheet_copy As String, location_insert As Integer)
    On Error GoTo EXIT_SUB
    Sheets(name_sheet_copy).Copy Before:=Sheets(location_insert)
EXIT_SUB:
    MsgBox ("COPY_SHEET_NAME: Ten sheet(" + name_sheet_copy + ") khong ton tai.")
End Sub

'====================================================================
'STT: 19                                                            =
'Ten Ham: Delete_Sheet(name_sheet_delete)                           =
'Chuc nang: Xoa sheet duoc chi dinh                                 =
'Nguoi tao: V.Cong                                                  =
'Ngay tao: 2017/05/24                                               =
'====================================================================
Public Sub Delete_Sheet(name_sheet_delete As String)
    On Error GoTo EXIT_SUB
    Sheets(name_sheet_delete).Delete
    Exit Sub
EXIT_SUB:

#7

'=======================
'Kiem tra da sua loi chua
Sub KiemTraSuaLoi()
    Const ROW_BEGIN = 6
    Const COL_STT = 2

    Dim last_row, last_col As Integer
    last_row = ActiveCell.SpecialCells(xlLastCell).Row
    last_col = ActiveCell.SpecialCells(xlLastCell).Column

    Dim filename1, filename2 As String
    filename1 = "file 1"
    filename1 = "file 2"
    Dim Col_th(4) As Integer
    Col_th(1) = 5
    Col_th(2) = 7
    Col_th(3) = 9
    Col_th(4) = 11

    ' Dinh nghia cot 1st 2nd 3th 4th
    For Row = ROW_BEGIN To last_row
    For Index = 1 To UBound(Col_th, 1)
    If Cells(Row, Col_th(Index)) <> "" Then
        If DateValue(Cells(Row, Col_th(Index))) > DateValue(Date) And Cells(Row, Col_th(Index) + 1) = "" Then
            'Fill Red 255
            Cells(Row, COL_STT).Interior.Color = 255
        'Else
            'Fill No Color 16777215
            'Cells(Row, COL_STT).Interior.Color = 16777215
        End If
    End If
    Next Index
     Next Row
End Sub