NguyenDang95
Senior Member
Chào mọi người. Trong công việc, mọi người thường thao tác với hàng đống tập tin khác nhau. Những tập tin này được lưu chung một thư mục với đủ các định dạng khác nhau (vd: .docx, .pdf, .xlsx, ...). Giả sử người dùng muốn xem xem trong thư mục đó có những loại file Excel nào, tên gì,... để tiện quản lý, thì ngoài thao tác thủ công ra, chúng ta có thể viết một macro nhỏ để Excel liệt kê một danh sách một cách hoàn toàn tự động.
Macro dưới đây sẽ:
Kết quả:
Macro dưới đây sẽ:
- Hiển thị hộp thoại để người dùng chọn thư mục
- Excel sẽ duyệt qua từng tập tin, nếu là định dạng tập tin Excel thì tiến hành liệt kê, cho ra kết quả
Code:
Option Explicit
Private Sub ListExcelFilesInFolder()
Dim objWb As Excel.Workbook
Dim objSh As Excel.Worksheet
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim objFolderPicker As FileDialog
Dim lngRow, lngCount As Long
Dim strPath As String
Set objFolderPicker = Application.FileDialog(msoFileDialogFolderPicker)
With objFolderPicker
.Title = "Select a folder that contains your Excel file(s)"
.Show
If .SelectedItems.Count = 0 Then
Exit Sub
Else: strPath = .SelectedItems(1) & "\"
End If
End With
Set objWb = Workbooks.Add
Set objSh = objWb.Sheets(1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)
With objSh
.Range("E2").Value = "List of Excel Files"
.Range("E2").Font.Size = 16
.Range("E2").Font.Bold = True
.Range("C3").Value = "Directory:"
.Range("D3").Value = objFolder.Path
.Range("C3").Offset(1, 0).Value = "Count of File(s):"
.Range("B6").Value = "File Name"
.Range("B6").Offset(0, 1).Value = "Type of File"
.Range("B6").Offset(0, 2).Value = "Date Created"
.Range("B6").Offset(0, 3).Value = "Date Last Accessed"
.Range("B6").Offset(0, 4).Value = "Date Last Modified"
.Range("B6").Offset(0, 5).Value = "Size in Kilobytes"
.Range("B6").Offset(0, 6).Value = "Link to Open File"
End With
lngRow = 7
For Each objFile In objFolder.Files
With objFile
lngCount = lngCount + 1
objSh.Cells(lngRow, 2).Value = .Name
objSh.Cells(lngRow, 4).Value = .DateCreated
objSh.Cells(lngRow, 5).Value = .DateLastAccessed
objSh.Cells(lngRow, 6).Value = .DateLastModified
objSh.Cells(lngRow, 7).Value = BytesToKilobytes(.Size)
objSh.Hyperlinks.Add Anchor:=objSh.Cells(lngRow, 8), Address:=.Path, ScreenTip:="Click to Open", TextToDisplay:="Open"
Select Case GetFileExtension(.Name)
Case ".xlsx": objSh.Cells(lngRow, 3).Value = "Excel Workbook"
Case ".xls": objSh.Cells(lngRow, 3).Value = "Excel 97-2003 Workbook"
Case ".xlsm": objSh.Cells(lngRow, 3).Value = "Excel Macro-Enabled Workbook"
Case ".xlam": objSh.Cells(lngRow, 3).Value = "Excel Add-In"
Case ".xla": objSh.Cells(lngRow, 3).Value = "Excel 97-2003 Add-In"
End Select
End With
lngRow = lngRow + 1
Next objFile
objSh.Range("D4").Value = lngCount
objSh.Range("B:H").Columns.AutoFit
objSh.Range("B6:H6").Font.Bold = True
Set objWb = Nothing
Set objSh = Nothing
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
Set objFolderPicker = Nothing
End Sub
Private Function GetFileExtension(FileName As String) As String
GetFileExtension = Mid(FileName, InStrRev(FileName, "."))
End Function
Private Function BytesToKilobytes(Bytes As Long) As Long
BytesToKilobytes = Round(Bytes / 1000, 0)
End FunctionKết quả:
Last edited:
và dạng file khi lưu ra thường có dạng xlsm , xlsxm
