Bài viết: Tổng quan về FileSystemObject (phần 2)

[Quang_Hải]

Trong bài số 1 chúng ta đã làm quen với những phương thức cơ bản của FileSytemObject
Bài này chúng ta sẽ cũng tham khảo các ứng dụng thực tế và các cách liên kết các phương thức với nhau
Dưới đây là code dùng duyệt qua tất cả các file trong 1 thư mục. Tìm xem file nào có đuôi là tmp thì xóa bỏ.
Code này sẽ xóa cả file mang thuộc tính ẩn hoặc file hệ thống.

Sub DeleteTmpFile()
Dim fso As Object, ObjFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
   With fso.GetFolder(ThisWorkbook.Path)
      For Each ObjFile In .Files
         If fso.GetExtensionName(ObjFile) = "tmp" Then
            fso.DeleteFile (ObjFile)
         End If
      Next
   End With
End Sub

Cũng với code trên ta có thể tạo ra 2 Sub riêng biệt. Khi cần chỉ thay đổi đường dẫn tại Sub Main

Sub DeleteTmpFile(ByVal StrFolder As String)
Dim fso As Object, ObjFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
   With fso.GetFolder(StrFolder)
      For Each ObjFile In .Files
         If fso.GetExtensionName(ObjFile) = "tmp" Then
            fso.DeleteFile (ObjFile)
         End If
      Next
   End With
End Sub
Sub Main()
Dim path As String
path = ThisWorkbook.path
DeleteTmpFile (path)
End Sub

Để cho linh động hơn trong việc chọn thư mục, ta sẽ bổ sung code thế này

Sub DeleteTmpFile()
Dim fso As Object, ObjFile As Object
Dim path As String, chk As Boolean
chk = Application.FileDialog(msoFileDialogFolderPicker).Show
If Not chk Then Exit Sub
path = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Set fso = CreateObject("Scripting.FileSystemObject")
   With fso.GetFolder(path)
      For Each ObjFile In .Files
         If fso.GetExtensionName(ObjFile) = "tmp" Then
            fso.DeleteFile (ObjFile)
         End If
      Next
   End With
End Sub

Chỉ cần điều chỉnh lại 1 chút thì từ code trên ta sẽ tạo ra 1 code để liệt kê tất cả file excel trong 1 thư mục chỉ định
Khi đã có được 1 mảng chứa tên file rồi thì ta có thể xử lý theo yêu cầu cụ thể cho từng trường hợp.

Sub GetFileList()
Dim fso As Object, ObjFile As Object
Dim path As String, chk As Boolean, Res(), I As Long
chk = Application.FileDialog(msoFileDialogFolderPicker).Show
If Not chk Then Exit Sub
path = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Set fso = CreateObject("Scripting.FileSystemObject")
   With fso.GetFolder(path)
      For Each ObjFile In .Files
         If fso.GetExtensionName(ObjFile) Like "xls*" Then
            I=I+1
            ReDim Preserve Res(1 To I)
            Res(I)=ObjFile.Name
         End If
      Next
   End With
End Sub

Hoặc ta có thể tách ra thành 1 UDF và 1 Sub Main thế này

Sub Main()
Dim path As String, chk As Boolean, Sarr()
With Application.FileDialog(msoFileDialogFolderPicker)
   chk = .Show
   If Not chk Then Exit Sub
   path = .SelectedItems(1)
   Sarr = GetFileList(path)
End With
End Sub
Function GetFileList(ByVal StrFolder As String)
Dim fso As Object, ObjFile As Object
Dim Res(), K As Long
Set fso = CreateObject("Scripting.FileSystemObject")
   With fso.GetFolder(StrFolder)
      For Each ObjFile In .Files
         If fso.GetExtensionName(ObjFile) Like "xls*" Then
            K = K + 1
            ReDim Preserve Res(1 To K)
            Res(K) = ObjFile.Name
         End If
      Next
   End With
   GetFileList = Res
End Function

Đây là 1 code dùng để import dữ liệu từ 1 hay nhiều file txt vào file excel.
Với code này bạn chỉ cần kiểm tra xem file txt sử dụng dấu phân cách gì và sửa lại chỗ Delimiter= vbTab
Nếu dấu phân cách là dấu phẩy (,) thì sửa lại thế này Delimiter= ","
Lưu ý là code này khai báo chỉ số lớn nhất của mảng chỉ có 65536, nếu dữ liệu có nhiều hơn thì sẽ gây ra lỗi. Trong trường hợp đó bạn có thể sửa số 65536 thành 1 số lớn hơn. (Chắc hiếm gặp)
Code này sẽ xử lý tất cả file text xong rồi mới gán dữ liệu 1 lần xuống sheet tại ô A2. Bạn có thể sửa lại cho phù hợp.

Sub ImportTextToExcel()
Dim fso As Object, FilesToOpen, TextSource As Object, TotalLines, Res()
Dim ItemsOfLine, TextItem, Delimiter As String, n As Byte
Dim K As Long, X As Byte, Cols As Integer, LineNum As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Delimiter = vbTab
FilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
If Not IsArray(FilesToOpen) Then Exit Sub
For X = LBound(FilesToOpen) To UBound(FilesToOpen)
   Set TextSource = fso.OpenTextFile(FilesToOpen(X), 1, , -2)
   TotalLines = Split(TextSource.ReadAll, vbCrLf)
   For LineNum = LBound(TotalLines) To UBound(TotalLines)
      ItemsOfLine = TotalLines(LineNum)
      TextItem = Split(ItemsOfLine, Delimiter)
      If UBound(TextItem) + 1 > n Then
          ReDim Preserve Res(1 To 65536, 1 To UBound(TextItem) + 1)
          n = UBound(TextItem) + 1
      End If
      If ItemsOfLine <> String(Len(ItemsOfLine), vbTab) Then
         K = K + 1
         For Cols = LBound(TextItem) To UBound(TextItem)
            Res(K, Cols + 1) = TextItem(Cols)
         Next
      End If
   Next
Next
[A2].Resize(K, UBound(Res, 2)) = Res
End Sub

Và đây là 1 mẫu code để lấy tất cả file trong 1 thư mục mẹ và file trong thư mục con nếu có.
Code này sưu tầm của thành viên Siwtom

Sub Main()
Dim fso As Object, res() As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            ReDim res(1 To 1)
            GetAllFiles .SelectedItems(1), fso, res
            If UBound(res) > 1 Then [A5].Resize(UBound(res) - 1) = Application.Transpose(res)
        End If
    End With
End Sub
Function GetAllFiles(ByVal StrFolder As String, fso As Object, res() As String)
Dim objFolder As Object, objSubFolder As Object, File
    Set objFolder = fso.GetFolder(StrFolder)
    For Each File In objFolder.Files
        res(UBound(res)) = fso.GetBaseName(File)
        ReDim Preserve res(1 To UBound(res) + 1)
    Next
    For Each objSubFolder In objFolder.SubFolders
        GetAllFiles objSubFolder.Path, fso, res
    Next objSubFolder
End Function

Bài viết này là một sự tri ân của mình đối với các thành viên GPE, và cũng là món quà mình gởi tặng tất cả các thành viên xa gần đang làm quen với VBA.

Cảm ơn vì tất cả

Một số bài viết có liên quan:
1/ Tổng quan về FileSystemObject (phần 1)
2/ Các phương pháp để đo thời gian thực thi mã lệnh trong VB/VBA
3/ Một số hàm và thủ tục làm việc với Name trong VBA
4/ Sử dụng Name trong VBA
5/ Hàm người dùng và mảng
6/ Làm việc với mảng trong một thủ tục
7/ Làm việc với mảng trong VBA
8/ Giới thiệu VBA trong Excel
9/ Tầm vực truy xuất, thời gian sống của biến & thủ tục
10/ Khai báo biến và đặt tên biến trong VBA