Tổng quan về FileSystemObject

[Quang_Hải]

Nhằm mục đích giúp cho các bạn mới và đang tự học lập trình trong Excel, tôi xin tóm tắt các khái niệm và ứng dụng phổ thông nhất về công cụ FileSystemObject.

1. FileSystemObject là gì?
FSO là 1 công cụ mạnh chuyên dùng để xử lý các vấn đề liên quan đến Drive, Folders và Files. Bài viết này chủ yếu tập trung vào Folders và Files.
2. Các ứng dụng cơ bản và code điển hình
2.1 -Khởi tạo kích hoạt công cụ FSO:
Khi muốn sử dụng công cụ FSO thì ta phải khởi tạo kích hoạt trước khi gọi các lệnh liên quan đến FSO. Sau đây là cách khởi tạo phổ thông nhất mà ta thường gặp

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

Sau dòng lệnh trên thì ta đã có thể gọi các lệnh liên quan đến công cụ này để xử lý những yêu câu tiếp theo.
2.2 -Các phương thức phổ biến
a. CreateFolder (dùng để tạo 1 thư mục mới)
Cơ bản của lệnh này như sau:

Dim fso As Object, NewFolder As String
Set fso = CreateObject("Scripting.FileSystemObject")
NewFolder = "D:\Sample"
fso.CreateFolder (NewFolder)

Sau khi thực thi các câu lệnh trên thì 1 thư mục có tên là Sample đã được tạo ra trong ổ đĩa D.
Điều đáng chú ý là công cụ này có thể xử lý tốt tiếng Việt có dấu.
Nếu thư mục này đã có sẵn rồi thì sẽ bị lỗi code. Để khắc phục điều này chúng ta sẽ cùng tìm hiểu trong phần sau.
b. DeleteFolder (dùng để xóa 1 thư mục có sẵn)

Dim fso As Object, FolderToDelete As String
Set fso = CreateObject("Scripting.FileSystemObject")
FolderToDelete= "D:\Sample"
fso.DeleteFolder(FolderToDelete)

Sau khi thực thi các câu lệnh trên thì thư mục có tên là Sample trong ổ đĩa D sẽ bi xóa.
Ở đây ta bỏ qua tham số True và False của phương thức này. Mặc định luôn là True.
Chú ý là nếu có file(s) nào đang mở thì thư mục này không bị xóa, tuy nhiên các file trong thư mục này sẽ bị xóa hết trừ file(s) đang mở. Lúc này sẽ xuất hiện 1 thông báo lỗi không thể truy cập.
Hoặc ta cung cấp tên 1 thư mục không tồn tại thì cũng sẽ gây ra lỗi. Vấn đề này sẽ được xử lý bằng 1 phương thức tiếp theo.

c. FolderExists (dùng để kiểm tra xem thư mục có tồn tại hay không)
Khi tạo 1 thư mục vào 1 đường dẫn đã có tồn tại 1 thư mục trùng tên thì sẽ gây ra lỗi. Để khắc phục vấn đề này ta sử dụng phương thức FolderExists

Dim fso As Object, NewFolder As String
Set fso = CreateObject("Scripting.FileSystemObject")
NewFolder = "D:\Sample"
If Not fso.FolderExists(NewFolder) then
     fso.CreateFolder (NewFolder)
End If

Như vậy lỗi tạo thư mục trùng tên đã bị loại bỏ. Tương tự, ta có thể kiểm tra trước khi thực thi câu lệnh DeleteFolder

Dim fso As Object, FolderToDelete As String
Set fso = CreateObject("Scripting.FileSystemObject")
FolderToDelete= "D:\Sample"
If fso.FolderExists(NewFolder) then
       fso.DeleteFolder(FolderToDelete)
End If

*** Ngoài ra ta có 1 cách tạo thư mục khác cũng dùng FSO như sau:

Dim fso As Object, NewFolder As String
Set fso = CreateObject("Scripting.FileSystemObject")
NewFolder= "Sample"
fso.GetFolder("D:").SubFolders.Add "NewFolder"

d. CopyFolder (dùng để copy 1 folder từ nơi này đến nơi khác)
Trên thực tế ít khi chúng ta sử dụng phương thức này

Dim fso As Object, FolderToCopy As String, DesFolder As String
Set fso = CreateObject("Scripting.FileSystemObject")
FolderToCopy= "D:\Sample"
DesFolder= "E:\Sample"
fso.CopyFolder FolderToCopy, DesFolder

e. GetParentFolderName (dùng để lấy tên thư mục mẹ của 1 Folder hoặc của 1 file)
Phương thức GetParentFolderName rất thuận tiện khi ta muốn lấy tên thư mục mẹ của 1 file hay 1 thư mục nào đó. Câu lệnh dưới đây sẽ trả về cho ta chuỗi D:\Sample, với Item1 là thư mục.

Dim fso As Object, CurrentFolder As String
Set fso = CreateObject("Scripting.FileSystemObject")
CurrentFolder= "D:\Sample\Item1"
Msgbox  fso.GetParentFolderName(CurrentFolder)

Nếu chuỗi đường dẫn là 1 file thì sẽ trả về cho ta thư mục chứa file đó
Code sau đây sẽ trả về cho ta chuỗi D:\Sample\Item1

Dim fso As Object, CurrentFile As String
Set fso = CreateObject("Scripting.FileSystemObject")
CurrentFile= "D:\Sample\Item1\Baitap.xls"
Msgbox  fso.GetParentFolderName(CurrentFile)

f. GetAbsolutePathName (dùng để lấy tên đường dẫn đầy đủ của 1 file hoặc 1 thư mục)
Code này sẽ trả về cho ta chuỗi D:\Sample\Item1\Baitap.xls

Dim fso As Object, CurrentFile As String
Set fso = CreateObject("Scripting.FileSystemObject")
CurrentFile= "D:\Sample\Item1\Baitap.xls"
Msgbox  fso.GetAbsolutePathName(CurrentFile)

g. GetBaseName (dùng để lấy tên của 1 file không kèm theo phần mở rộng)
Code này sẽ trả về cho ta chuỗi Baitap

Dim fso As Object, CurrentFile As String
Set fso = CreateObject("Scripting.FileSystemObject")
CurrentFile= "D:\Sample\Item1\Baitap.xls"
Msgbox  fso.GetBaseName(CurrentFile)

h. GetExtensionName (dùng để lấy phần mở rộng của 1 file)
Code này sẽ trả về cho ta chuỗi xls

Dim fso As Object, CurrentFile As String
Set fso = CreateObject("Scripting.FileSystemObject")
CurrentFile= "D:\Sample\Item1\Baitap.xls"
Msgbox  fso.GetExtensionName (CurrentFile)

i. CopyFile (dùng để copy file(s) từ 1 thư mục đến thư mục khác)
Cái thú vị của lệnh này là nếu ta chỉ ra đường dẫn và tên file đích, thì code sẽ lấy tên file mà ta đã chỉ định.
Thông thường ta sẽ thực hiện code thế này để copy file

Dim fso As Object, FileToCopy As String, Des As String
Set fso = CreateObject("Scripting.FileSystemObject")
FileToCopy= "D:\Sample\Item1\Baitap.xls"
Des="D:\Sample\Item2\Baitap.xls"
fso.CopyFile FileToCopy, Des

Tuy nhiên nếu ta viết thế này thì code vẫn hiểu. Nếu ta không chỉ định tên file thì code sẽ lấy tên file gốc.
Nếu ta muốn đổi tên file thì code sẽ cho ta tên file mới với cùng nội dung trong file.

Dim fso As Object, FileToCopy As String, Des As String
Set fso = CreateObject("Scripting.FileSystemObject")
FileToCopy= "D:\Sample\Item1\Baitap.xls"
Des="D:\Sample\Item2\"
fso.CopyFile FileToCopy, Des

j. DeleteFile (dùng để xoá 1 file có thuộc tính ẩn hoặc không ẩn)
Code sau đây sẽ xoá 1 tập tin tên Baitap.xls trong thư mục Item1
Lưu ý là ở đây chúng ta bỏ qua tham số thứ 2 của phương thức này.
Nếu file chỉ định để xoá không tồn tại thì sẽ gây ra lỗi code

Dim fso As Object, FileToDelete As String
Set fso = CreateObject("Scripting.FileSystemObject")
FileToDelete= "D:\Sample\Item1\Baitap.xls"
fso.DeleteFile(FileToDelete)

k. FileExists (dùng để kiểm tra sự tồn tại của 1 tập tin)
Để khắc phục lỗi có thể xảy ra khi ta yêu cầu xoá 1 tập tin không tồn tại thì phương thức FileExists sẽ giúp chúng ta thực hiện điều này.

Dim fso As Object, FileToDelete As String
Set fso = CreateObject("Scripting.FileSystemObject")
FileToDelete= "D:\Sample\Item1\Baitap.xls"
If fso.FileExists(FileToDelete) Then
    fso.DeleteFile(FileToDelete)
End If

l. CreateTextFile (dùng để xuất dữ liệu thành 1 file dạng txt)
Với phương thức này ta nên lưu ý đến các tham số
fso.CreateTextFile(filename, overwrite, unicode)
Code sau đây sẽ xuất nội dung từ A1 đến A10 vào file txt

   Dim fso As Object, MyFile  As Object
   Dim FileName As String, I As Long
   Set fso = CreateObject("Scripting.FileSystemObject")
   FileName = "D:\Test.txt"
   Set MyFile = fso.CreateTextFile(FileName, True, True)
   With MyFile
      For I = 1 To 10
         .WriteLine cells(i,1)
      Next
      .Close
   End With

Nếu ta muốn xuất nhiều cột thì phải nối các cột lại với nhau bằng 1 dấu phân cách để khi cần truy xuất.
Code sau đây dùng dấu tab để nối dữ liệu của cột A và B.
Lưu ý là nếu có quá nhiều cột thì ta nên dùng vòng lặp lồng để nối các cột trước khi ghi vào file

   Dim fso As Object, MyFile  As Object
   Dim FileName As String, I As Long
   Set fso = CreateObject("Scripting.FileSystemObject")
   FileName = "D:\Test.txt"
   Set MyFile = fso.CreateTextFile(FileName, True, True)
   With MyFile
      For I = 1 To 10
         .WriteLine cells(i,1) & vbTab & cells(i,2)
      Next
      .Close
   End With

m. OpenTextFile (dùng để mở 1 file txt)

Đối với phương thức này chúng ta cần lưu ý đến các tham số.
fspenTextFile(filename, mode, create, format)
Tham số 1: tên đường dẫn file
Tham số 2: để đọc file (1), để ghi đè (2), để cập nhật tiếp (8).
Tham số 3: tạo file mới (True), bỏ trống mặc định là False.
Tham số 4: as unicode (-1), as ASCII (1), system default (-2).
Code sau đây sẽ mở file Test.txt có sẵn để ghi tiếp dữ liệu vào dòng cuối.
Nếu file này không tồn tại sẽ gây ra lỗi. Ta có thể dùng phương thức FileExists để bẫy lỗi này.

   Dim fso As Object, MyFile  As Object
   Dim FileName As String, I As Long
   Set fso = CreateObject("Scripting.FileSystemObject")
   FileName = "D:\Test.txt"
   Set MyFile = fso.OpenTextFile(FileName, 8,False, -1)
   With MyFile
      For I = 1 To 10
         .WriteLine cells(i,1) & vbTab & cells(i,2)
      Next
      .Close
   End With

Khi ta muốn Import dữ liệu từ 1 file txt vào Excel thì cũng dùng phương thức OpenTextFile.
Phần này được dùng tương đối nhiều và cũng là 1 trong những cái phần quan trọng và khó.
Trước tiên ta phải biết được dấu phân cách dữ liệu của file txt. Giả định trong bài này là dấu vbTab.
Khi ta dùng phương thức để đọc dữ liệu từ file txt thì fso sẽ cho ta 1 chuỗi dữ liệu liên tục được nối với nhau bằng những dấu xuống dòng (vbCrLf).
Sau khi đọc từ file ta có 1 chuỗi:
"a b c vbCrLf d e f vbCrLf h i j vbCrLf k l m....................................."
Bước tiếp theo là ta dùng hàm Split của VBA để tách cái chuỗi dài lê thê này ra, dựa trên các dấu (vbCrLf).
Sau khi tách chuỗi trên ra ta sẽ có như sau:
"a b c"
"d e f"
"h i j"
"k l m"
Tiếp theo ta sẽ dùng hàm Split để tách tiếp những phần tử được ngăn cách bởi dấu vbTab
Kết quả sau khi tách như sau:
"a" "b" "c"
"d" "e" " f"
................
Đến đây ta sẽ gán các giá trị này vào vùng dữ liệu đích.

Chúng ta cùng tham khảo 1 code cơ bản để import dữ liệu từ 1 file txt
Vì là code cơ bản nên ta chưa loại bỏ hết những phát sinh có thể xảy ra.

Sub ImportTextToExcel()
   Dim fso As Object, TextSource As Object, TotalLines, TextItem
   Dim ItemsOfLine As String, Delimiter As String, FilesToOpen As String, Res()
   Dim K As Long, Cols As Integer, LineNum As Long
   Set fso = CreateObject("Scripting.FileSystemObject")
   Delimiter = vbTab
   FilesToOpen = "D:\Sample\Test.txt"
   Set TextSource = fso.OpenTextFile(FilesToOpen, 1, False, -2)
   TotalLines = Split(TextSource.ReadAll, vbCrLf)
   ReDim Res(1 To 1 + UBound(TotalLines), 1 To 1)
   For LineNum = LBound(TotalLines) To UBound(TotalLines)
      ItemsOfLine = TotalLines(LineNum)
      TextItem = Split(ItemsOfLine, Delimiter)
      If UBound(Res, 2) < UBound(TextItem) + 1 Then
          ReDim Preserve Res(1 To 1 + UBound(TotalLines), 1 To UBound(TextItem) + 1)
      End If
      K = K + 1
      For Cols = LBound(TextItem) To UBound(TextItem)
         Res(K, Cols + 1) = TextItem(Cols)
      Next
   Next
   [A1].Resize(K, UBound(Res, 2)) = Res
End Sub

 

[haog]

Chào Hesanbi.
Đọc https://docs.microsoft.com/en-us/of...ce-help/size-property-filesystemobject-object
(tất nhiên có nhờ dịch) trích được đoạn code sau

Sub ShowFolderSize(filespec)
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(filespec)
s = UCase(f.Name) & " uses " & f.size & " bytes."
MsgBox s, 0, "Folder Size Info"
End Sub

thì hiểu cách dùng thành viên của Scripting.File. Bạn không cần trả lời nữa.

Viết thêm (sửa): Nếu viết đúng như sub trên thì khi edit, nhập f. không thấy hiện gì. Vậy ta nên khai báo 1 biến , vd ff as Scripting.File thì trong code, nhập ff. thì chọn được size. Rồi sửa ff thành f.

 

[HeSanbi]

Chào Hesanbi.
Đọc https://docs.microsoft.com/en-us/of...ce-help/size-property-filesystemobject-object
(tất nhiên có nhờ dịch) trích được đoạn code sau

Sub ShowFolderSize(filespec)
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(filespec)
s = UCase(f.Name) & " uses " & f.size & " bytes."
MsgBox s, 0, "Folder Size Info"
End Sub

thì hiểu cách dùng thành viên của Scripting.File. Bạn không cần trả lời nữa.

Viết thêm (sửa): Nếu viết đúng như sub trên thì khi edit, nhập f. không thấy hiện gì. Vậy ta nên khai báo 1 biến , vd ff as Scripting.File thì trong code, nhập ff. thì chọn được size. Rồi sửa ff thành f.

Vậy là bạn chưa hiểu về Early Binding và Late Binding rồi.

Early Binding - Sẽ dành cho lập trình viên hoặc người đang học tập:
Để làm gì? Dễ dàng viết code vì nó tự động gợi ý ,hoàn thành đoạn mã, và nhiều nhiều.
Phải khai báo thư viện trong Tools thì mới Dim FS As Scripting.FileSystemObject

Dim FS As Scripting.FileSystemObject
Set FS = New Scripting.FileSystemObject
Hoặc:
With New Scripting.FileSystemObject
End With
Hoặc:

Dim FS As New Scripting.FileSystemObject

Late Binding - tương thích với nhiều máy, khi hoàn thành ứng dụng thì chuyển về Late Binding:
Không cần khai bào thư viện - Nhưng nó sẽ xảy ra một số lỗi nạp chồng.

Dim FS As Object
Set FS = CreateObject("Scripting.FileSystemObject")

 

[hoangexcell]

CreateTextFile (dùng để xuất dữ liệu thành 1 file dạng txt)
Với phương thức này ta nên lưu ý đến các tham số
fso.CreateTextFile(filename, overwrite, unicode)
Code sau đây sẽ xuất nội dung từ A1 đến A10 vào file txt

Cho e xin code để copy 1 sheet ra thành 1 file, và chuyển đổi chỉ còn giá trị. Em cảm ơn

 

[khitamdao]

Chào mọi người, mình có dữ liệu trong file text kiểu như sau: Kết thúc mỗi chuỗi là dấu =

"48839 31696 60204 10242 20218 30085 40150 57027 71022 865// 222// 00234 20001 09299
E0661 333 58020 86696=
48834 32660 80502 10195 20168 30077 40159 57029 885// 222// 00203 20000 09294 E1051
333 58018 88696=
48/43 01470 80503 10148 20128 69943 70262 888// 333 69941 82894 88696 555 20130="

1 chuỗi là 1 dòng có dạng như dòng này:
48/43 01470 80503 10148 20128 69943 70262 888// 333 69941 82894 88696 555 20130=

bây giờ có chuổi người ta chia làm 2 dòng như sau:
"48839 31696 60204 10242 20218 30085 40150 57027 71022 865// 222// 00234 20001 09299
E0661 333 58020 86696="

cho mình hỏi phải viết code như nào để nhận 2 dòng này làm 1 chuỗi
xin cảm ơn

 

[samsun]

Chào các bạn,
Các bạn làm ơn cho hỏi, có cách nào dùng phương thức FileSystemObject để biết được 1 file nào đó / hoặc 1 file Excel đang mở hay không?
Trân trọng cám ơn
doaimd@gmail.com

https://www.giaiphapexcel.com/diendan/forums/lập-trình-với-excel.79/post-thread

 

[minhke1989]

Anh ơi cho em hỏi, nếu mình muốn xóa các thư mục rỗng có sẵn trong list excel, và trước khi xóa mình cần check xem thư mục đó có rỗng hay không thì làm ntn ạ? Em cám ơn

 

[ketoan113]

Em chào các anh chị
Em có làm file import file txt vào excel dùng FSO mà đang bị lỗi font chữ, hiện tại chưa biết sửa sao cho hết lỗi font
Em nhờ anh chị giúp đỡ với, em xin cảm ơn.

 

[Hoàng Tuấn 868]

em chào các anh chị
em có làm file import file txt vào excel dùng FSO mà đang bị lỗi font chữ, hiện tại chưa biết sửa sao cho hết lỗi font
em nhờ anh chị giúp đỡ với, em xin cảm ơn.

Chà chà, cả bài viết của bạn này không đầu dòng nào viết hoa thì lỗi phông chữ cũng là điều bình thường nhỉ.

 

[ketoan113]

Chà chà, cả bài viết của bạn này không đầu dòng nào viết hoa thì lỗi phông chữ cũng là điều bình thường nhỉ.

Dạ, để em sửa lại

 

[hoangtuan.net]

Dạ, để em sửa lại

Thư viện JSON VBA, như nhiều thư viện khác trong VBA, không hỗ trợ trực tiếp mã hóa Unicode. Nó hoạt động tốt nhất với mã hóa Windows-1252 (hoặc tương đương). Điều này có nghĩa là nếu bạn cố gắng xử lý dữ liệu Unicode bằng thư viện JSON VBA, bạn có thể gặp phải các vấn đề với các ký tự không phải ASCII.

Nếu bạn cần xử lý dữ liệu Unicode trong VBA, bạn có thể cần sử dụng một thư viện hoặc phương pháp khác có hỗ trợ Unicode. Một số giải pháp có thể bao gồm việc sử dụng một thư viện JSON khác, hoặc chuyển đổi dữ liệu của bạn thành một định dạng khác như UTF-8 trước khi xử lý nó với thư viện JSON VBA. Tuy nhiên, cần lưu ý rằng việc chuyển đổi này có thể không hoàn toàn chính xác và có thể dẫn đến mất dữ liệu hoặc sai lệch.

Một giải pháp tạm thời mình đưa ra là thêm 1 đoạn mã convert như sau:

Function ConvertToUTF8(inputString As String) As String
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")
    stream.Open
    stream.Type = 2 ' text
    stream.Charset = "windows-1252"
    stream.WriteText inputString
    stream.Position = 0
    stream.Type = 1 ' binary
    stream.Position = 3 ' skip BOM
    Dim bytes: bytes = stream.Read
    stream.Close

    Set stream = CreateObject("ADODB.Stream")
    stream.Open
    stream.Type = 1 ' binary
    stream.Write bytes
    stream.Position = 0
    stream.Type = 2 ' text
    stream.Charset = "utf-8"
    ConvertToUTF8 = stream.ReadText
    stream.Close
End Function

 

[ketoan113]

Thư viện JSON VBA, như nhiều thư viện khác trong VBA, không hỗ trợ trực tiếp mã hóa Unicode. Nó hoạt động tốt nhất với mã hóa Windows-1252 (hoặc tương đương). Điều này có nghĩa là nếu bạn cố gắng xử lý dữ liệu Unicode bằng thư viện JSON VBA, bạn có thể gặp phải các vấn đề với các ký tự không phải ASCII.

Nếu bạn cần xử lý dữ liệu Unicode trong VBA, bạn có thể cần sử dụng một thư viện hoặc phương pháp khác có hỗ trợ Unicode. Một số giải pháp có thể bao gồm việc sử dụng một thư viện JSON khác, hoặc chuyển đổi dữ liệu của bạn thành một định dạng khác như UTF-8 trước khi xử lý nó với thư viện JSON VBA. Tuy nhiên, cần lưu ý rằng việc chuyển đổi này có thể không hoàn toàn chính xác và có thể dẫn đến mất dữ liệu hoặc sai lệch.

Một giải pháp tạm thời mình đưa ra là thêm 1 đoạn mã convert như sau:

Function ConvertToUTF8(inputString As String) As String
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")
    stream.Open
    stream.Type = 2 ' text
    stream.Charset = "windows-1252"
    stream.WriteText inputString
    stream.Position = 0
    stream.Type = 1 ' binary
    stream.Position = 3 ' skip BOM
    Dim bytes: bytes = stream.Read
    stream.Close

    Set stream = CreateObject("ADODB.Stream")
    stream.Open
    stream.Type = 1 ' binary
    stream.Write bytes
    stream.Position = 0
    stream.Type = 2 ' text
    stream.Charset = "utf-8"
    ConvertToUTF8 = stream.ReadText
    stream.Close
End Function

Dạ, em xin cảm ơn anh nhiều.