34 C
Ho Chi Minh City
Tuesday, March 19, 2024
AIPHOGPT.COM
Trang chủVBA ExcelVBA Excel FileSystemObject trong Excel VBA

VBA Excel FileSystemObject trong Excel VBA

Join LeQuocThai.Com on Telegram Channel

Đánh giá lequocthai.com:

0 / 5 Voted: 0 Votes: 0

Your page rank:

Các bài viết có liên quan:
 
FileSystemObject (FSo) là một phần trong thư viện Microsoft Scripting Runtime (scrrun.dll), là công cụ chuyên xử lý về Drive, Folder, File.

1. Khai báo

1.1. Kiểu khai báo sớm
(Có Tooltip khi gọi FSo, phải thiết lập trong Tools/References)    
– Trong cửa sổ VBA, Tools menu, References.
– Tìm và check vào mục “Microsoft Scripting Runtime” trong cửa sổ References – VBAProject.
Khai báo trong code:
   
Dim FSo As Scripting.FileSystemObject
Set FSo = New Scripting.FileSystemObject

1.2. Kiểu khai báo muộn
(Không có Tooltip khi gọi FSo, không cần thiết lập trong Tools/References).
Khai báo trong code:
Dim FSo As Object
Set FSo = CreateObject("Scripting.FileSystemObject")

2. Các phương thức

2.1. BuildPath
FSo.BuildPath(Path As String, Name As String) As String

Phương thức BuildPath gán một tên vào một đường dẫn (trả về một chuỗi là đường dẫn).
Path: Bắt buộc. Đường dẫn để nối tên vào.
Name: Bắt buộc. Tên cần nối vào đường dẫn chỉ định.
Ví dụ:
Sub BuildPath()
'    Dim Fso As Scripting.FileSystemObject
'    Set Fso = New Scripting.FileSystemObject
    Dim FSo As Object
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Dim NewPath As String
    NewPath = FSo.BuildPath(ThisWorkbook.Path, "NewFolder")
    MsgBox NewPath
End Sub

2.2. CopyFile
FSo.CopyFile(Source As String, Destination As String, [OverWriteFiles As Boolean = True])

Source: Bắt buộc. Đường dẫn của một hoặc nhiều tập tin cần sao chép (Có thể sử dụng ký tự đại diện “*?”).
Destination: Bắt buộc. Nơi để dán tập tin đã sao chép (ký tự đại diện không thể được sử dụng).
OverWrite: Không bắt buộc. Một giá trị Boolean xác định một tập tin đã tồn tại có thể bị ghi đè hay không. True cho phép các tập tin đã có được ghi đè lên và False ngăn ngừa các tập tin đã có bị ghi đè lên. Mặc định là True.
Ví dụ:
Sub CopyFile()
'    Dim Fso As Scripting.FileSystemObject
'    Set Fso = New Scripting.FileSystemObject
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim sPath As String, dPath As String
    sPath = ThisWorkbook.Path & "\*.xlsx"
    dPath = "D:\Vidu"
    FSo.CopyFile sPath, dPath, True
End Sub

2.3. CopyFolder
FSo.CopyFolder(Source As String, Destination As String, [OverWriteFiles As Boolean = True])

Source: Bắt buộc. Đường dẫn của một hoặc nhiều thư mục cần sao chép (Có thể sử dụng ký tự đại diện “*?”).
Destination: Bắt buộc. Nơi để dán thư mục đã sao chép (ký tự đại diện không thể được sử dụng).
OverWriteFiles: Không bắt buộc. Một giá trị Boolean xác định một thư mục đã tồn tại có thể bị ghi đè hay không. True cho phép các thư mục đã có được ghi đè lên và False ngăn ngừa các thư mục đã có bị ghi đè lên. Mặc định là True.
Ví dụ:
Sub CopyFolders()
'Copy all the folders in "D:\Example"
'to the folder "D:\Vidu"
'    Dim Fso As Scripting.FileSystemObject
'    Set Fso = New Scripting.FileSystemObject
    Dim FSo As Object
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Dim sPath As String, dPath As String
    sPath = "D:\Example\*"
    dPath = "D:\Vidu"
    FSo.CopyFolder sPath, dPath, True
End Sub
'-----------------'
Sub CopyFolder()
'Copy only the folder "OldFolder" in "D:\Example"
'to the folder "D:\Vidu"
'    Dim Fso As Scripting.FileSystemObject
'    Set Fso = New Scripting.FileSystemObject
    Dim FSo As Object
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Dim sPath As String, dPath As String
    sPath = "D:\Example\OldFolder"
    dPath = "D:\Vidu"
    FSo.CopyFolder sPath, dPath, True
End Sub

2.4. CreateFolder
FSo.CreateFolder(Path As String) As Folder

Path: Bắt buộc. Là đường dẫn của thư mục cần tạo.
Nếu thư mục cần tạo đã tồn tại thì sẽ gặp lỗi, cần kiểm tra sự tồn tại trước khi tạo mới.
Ví dụ:
Sub CreateFolder()
'FSo.CreateFolder(Path As String) As Folder
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    FSo.CreateFolder (ThisWorkbook.Path & "\NewFolder")
    'Gap loi neu thu muc da ton tai, can kiem tra su ton tai cua thu muc do truoc khi dung .CreateFolder
End Sub

2.5. CreateTextFile
FSo.CreateTextFile(FileName As String, [OverWrite As Boolean = True], [Unicode As Boolean = False]) As TextStream

Tạo một tập tin văn bản dạng TextStream trong một thư mục chỉ định, có thể đọc và viết vào tập tin đó.
FileName: Bắt buộc. Là đường dẫn đầy đủ của tập tin cần tạo.
OverWrite. Không bắt buộc. Thiết lập cho phép có ghi đè tập tin đã tồn tại hay không. Mặc định là True, tức là cho phép ghi đè tập tin đã tồn tại. Ngược lại, False tức là không cho phép ghi đè.
Unicode: Không bắt buộc. Thiết lập tập tin văn bản được tạo dưới định dạng Unicode (ứng với True) hay ASCII (ứng với False). Mặc định là False.
Ví dụ:
Sub CreateTextFile()
'FSo.CreateTextFile(FileName As String, [OverWrite As Boolean = True], [Unicode As Boolean = False]) As TextStream
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim nameText As String, TxtFile As TextStream
    nameText = ThisWorkbook.Path & "\NewText.txt"
    Set TxtFile = FSo.CreateTextFile(nameText, True, True)
    TxtFile.WriteLine ("Hello World!")
    TxtFile.WriteLine ("This is a example!")
    TxtFile.Close
End Sub

2.6. DeleteFile
FSo.DeleteFile(FileSpec As String, [Force As Boolean = False])

FileSpec: Bắt buộc. Đường dẫn của một hoặc nhiều tập tin cần xóa, cho phép dùng ký tự đại diện (*?).
Force: Không bắt buộc. Thiết lập cho phép tập tin có thuộc tính Read-Only có bị xóa hay không. True cho phép tập tin Read-Only bị xóa, False thì chúng không bị xóa. Mặc định là False.
Lưu ý: Gặp lỗi nếu tập tin không tồn tại.
Ví dụ:
Sub DeleteFile()
'FSo.DeleteFile(FileSpec As String, [Force As Boolean = False])
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim nameText As String
    nameText = ThisWorkbook.Path & "\NewText.txt"
    FSo.CreateTextFile nameText, True, False
    'nameText = ThisWorkbook.Path & "\*.txt"
    FSo.DeleteFile nameText, True
    'Gap loi neu tap tin can xoa khong ton tai
End Sub

2.7. DeleteFolder
FSo.DeleteFolder(FolderSpec As String, [Force As Boolean = False])

FolderSpec: Bắt buộc. Là đường dẫn của một hoặc nhiều thư mục cần xóa, cho phép dùng ký tự đại diện.
Force: Không bắt buộc. Thiết lập cho phép thư mục có thuộc tính Read-Only có bị xóa hay không. True cho phép thư mục Read-Only bị xóa, False thì chúng không bị xóa. Mặc định là False.
Lưu ý: Gặp lỗi nếu thư mục không tồn tại.
Ví dụ:
Sub DeleteFolder()
'FSo.DeleteFolder(FolderSpec As String, [Force As Boolean = False])
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    FSo.DeleteFolder (ThisWorkbook.Path & "\NewFolder")
    'FSo.DeleteFolder (ThisWorkbook.Path & "\?")
End Sub

2.8. DriveExists
FSo.DriveExists(DriveSpec As String) As Boolean

Kiểm tra sự tồn tại của một ổ đĩa. Trả về True nếu nó tồn tại, ngược lại trả về False.
DriveSpec: Bắt buộc. Tên ổ đĩa cần kiểm tra.
Ví dụ:
Sub DriveExists()
'FSo.DriveExists(DriveSpec As String) As Boolean
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    MsgBox FSo.DriveExists("C:\")
End Sub

2.9. FileExists
FSo.FileExists(FileSpec As String) As Boolean

Kiểm tra sự tồn tại của một tập tin. Trả về True nếu nó tồn tại, ngược lại trả về False.
FileSpec: Bắt buộc. Đường dẫn đầy đủ của tập tin cần kiểm tra.
Ví dụ:
Sub FileExists()
'FSo.FileExists(FileSpec As String) As Boolean
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    MsgBox FSo.FileExists(ThisWorkbook.FullName)
End Sub

2.10. FolderExists
FSo.FolderExists(FolderSpec As String) As Boolean

Kiểm tra sự tồn tại của một thư mục. Trả về True nếu nó tồn tại, ngược lại trả về False.
FolderSpec: Bắt buộc. Đường dẫn đầy đủ của thư mục cần kiểm tra.
Ví dụ:
Sub FolderExists()
'FSo.FolderExists(FolderSpec As String) As Boolean
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    MsgBox FSo.FolderExists(ThisWorkbook.Path)
End Sub

2.11. GetAbsolutePathName
FSo.GetAbsolutePathName(Path As String) As String

Trả về đường dẫn đầy đủ từ ổ đĩa cho đường dẫn đưa vào.
Path: Bắt buộc. Là đường dẫn gợi ý để trả về đường dẫn đầy đủ.
Ví dụ: 
Sub GetAbsolutePathName()
'FSo.GetAbsolutePathName(Path As String) As String
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim sPath As String
    sPath = FSo.GetAbsolutePathName(ThisWorkbook.Name)
    MsgBox sPath
End Sub

2.12. GetBaseName
FSo.GetBaseName(Path As String) As String

Trả về tên cơ sở của một tập tin (tên của tập tin không gồm phần mở rộng) hoặc tên của thư mục cho thành phần cuối cùng trong một đường dẫn chỉ định đưa vào.
Path: Bắt buộc. Là đường dẫn của tập tin hay thư mục đưa vào.
Lưu ý: Path có thể là đường dẫn của tập tin hoặc thư mục.
Ví dụ:
Sub GetBaseName()
'FSo.GetBaseName(Path As String) As String
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim sPath As String
    sPath = FSo.GetBaseName(ThisWorkbook.Name)
    'sPath = FSo.GetBaseName(ThisWorkbook.Path)
    MsgBox sPath
End Sub

2.13. GetDrive
FSo.GetDrive(DriveSpec As String) As Drive

Trả về đối tượng Drive (ổ đĩa) tương ứng với ổ đĩa trong đường dẫn chỉ định đưa vào.
DriveSpec: Bắt buộc. Có thể ở dạng tên ổ đĩa (C,D,E), hoặc ở dạng (C:, D: ), ở dạng (C:\, D:\ ), hoặc ở dạng chia sẻ trong LAN (\\Computer\Folder2).
Đối tượng Drive có 12 thuộc tính.
Ví dụ:
Sub GetDrive()
'FSo.GetDrive(DriveSpec As String) As Drive
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim dDrive As Drive
    Set dDrive = FSo.GetDrive("C:\")
    MsgBox GetDriveProperties(dDrive)
End Sub

Public Function GetDriveProperties(ByVal dDrive As Drive) As String
    Dim Result()
    ReDim Result(1 To 20)
    With dDrive
        Result(1) = "AvailableSpace: " & .AvailableSpace
        Result(2) = "DriveLetter: " & .DriveLetter
        Result(3) = "DriveType: " & .DriveType
        Result(4) = "FileSystem: " & .FileSystem
        Result(5) = "FreeSpace: " & .FreeSpace
        Result(6) = "IsReady: " & .IsReady
        Result(7) = "Path: " & .Path
        Result(8) = "RootFolder: " & .RootFolder
        Result(9) = "SerialNumber: " & .SerialNumber
        Result(10) = "ShareName: " & .ShareName
        Result(11) = "TotalSize: " & .TotalSize
        Result(12) = "VolumeName: " & .VolumeName
    End With
    ReDim Preserve Result(1 To 12)
    GetDriveProperties = Join(Result, vbCrLf)
End Function

2.14. GetDriveName
FSo.GetDriveName(Path As String) As String

Trả về tên ổ đĩa từ đường dẫn chỉ định đưa vào.
Path: Bắt buộc. Là đường dẫn đưa vào sẽ trả về tên ổ đĩa.
Ví dụ:
Sub GetDriveName()
'FSo.GetDriveName(Path As String) As String
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    MsgBox FSo.GetDriveName(ThisWorkbook.Path)  'C:
End Sub

2.15. GetExtensionName
FSo.GetExtensionName(Path As String) As String

Trả về phần mở rộng của tập tin.
Path: Bắt buộc. Là đường dẫn đầy đủ của tập tin.
Ví dụ:
Sub GetExtensionName()
'FSo.GetExtensionName(Path As String) As String
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim extFile As String
    extFile = FSo.GetExtensionName(ThisWorkbook.FullName)
    MsgBox extFile
End Sub

2.16. GetFile
FSo.GetFile(FilePath As String) As File

Trả về đối tượng File.
FilePath: Bắt buộc. Là đường dẫn đầy đủ của tập tin.
Đối tượng File có 12 thuộc tính, 4 phương thức.
Ví dụ:
Sub GetFile()
'FSo.GetFile(FilePath As String) As File
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim oFile As File
    Set oFile = FSo.GetFile(ThisWorkbook.FullName)
    MsgBox GetFileProperties(oFile)
End Sub

Public Function GetFileProperties(ByVal oFile As File) As String
    Dim Result()
    ReDim Result(1 To 20)
    With oFile
        Result(1) = "Attributes: " & .Attributes
        Result(2) = "DateCreated: " & .DateCreated
        Result(3) = "DateLastAccessed: " & .DateLastAccessed
        Result(4) = "DateLastModified: " & .DateLastModified
        Result(5) = "Drive: " & .Drive
        Result(6) = "Name: " & .Name
        Result(7) = "ParentFolder: " & .ParentFolder
        Result(8) = "Path: " & .Path
        Result(9) = "ShortName: " & .ShortName
        Result(10) = "ShortPath: " & .ShortPath
        Result(11) = "Size: " & .Size
        Result(12) = "Type: " & .Type
    End With
    ReDim Preserve Result(1 To 12)
    GetFileProperties = Join(Result, vbCrLf)
End Function

Các phương thức của đối tượng File: Copy, Delete, Move, OpenTextStream
Sub FileMethods()
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim oFile As File
    Set oFile = FSo.GetFile(ThisWorkbook.FullName)
    'oFile.Copy (Destination As String, [OverWriteFiles As Boolean = True])
    'oFile.Delete([Force As Boolean = False])
    'oFile.Move(Destination As String)
    'oFile.OpenAsTextStream([IOMode As IOMode = ForReading],[Format As Tristate = TristateFalse]) As TextStream

    oFile.Copy "D:\", True
End Sub

2.17. GetFileName
FSo.GetFileName(Path As String) As String

Trả về tên của tập tin gồm cả phần mở rộng hoặc tên của thư mục cho thành phần cuối cùng trong một đường dẫn chỉ định đưa vào.
Path: Bắt buộc. Là đường dẫn của tập tin hoặc thư mục chỉ định.
Phương thức GetFileName trả về một chuỗi chứa tên tệp tin hoặc tên thư mục cho thành phần cuối cùng trong một đường dẫn được chỉ định.
Lưu ý:
– Nếu Path là đường dẫn của File thì:
GetFileName = GetBaseName & "." & GetExtensionName
GetFileName = oFile.Name

– Nếu Path là đường dẫn của Folder thì:
GetFileName = GetBaseName

Ví dụ:
Sub GetFileName()
'FSo.GetFileName(Path As String) As String
'1 - Nêu Path là File:
    'GetFileName = GetBaseName & "." & GetExtensionName
    'GetFileName = oFile.Name
'2 - Nêu Path là Folder:
    'GetFileName = GetBaseName
    
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim fName As String
    fName = FSo.GetFileName(ThisWorkbook.FullName)
    'fName = FSo.GetFileName(ThisWorkbook.Path)
    MsgBox fName
End Sub

2.18. GetFolder
FSo.GetFolder(FolderPath As String) As Folder

Trả về đối tượng Folder (thư mục).
FolderPath: Bắt buộc. Là đường dẫn của thư mục chỉ định.
Đối tượng Folder có 15 thuộc tính, 4 phương thức.
Lưu ý: Hai thuộc tính của đối tượng Folder: Files và SubFolders trả về một Collection (*).
Ví dụ:
Sub GetFolder()
'FSo.GetFolder(FolderPath As String) As Folder
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim oFolder As Folder
    Set oFolder = FSo.GetFolder(ThisWorkbook.Path)
    MsgBox GetFolderProperties(oFolder)
End Sub

Public Function GetFolderProperties(ByVal oFolder As Folder) As String
    Dim Result()
    ReDim Result(1 To 20)
    With oFolder
        Result(1) = "Attributes: " & .Attributes
        Result(2) = "DateCreated: " & .DateCreated
        Result(3) = "DateLastAccessed: " & .DateLastAccessed
        Result(4) = "DateLastModified: " & .DateLastModified
        Result(5) = "Drive: " & .Drive
        Result(6) = "Files.Count: " & .Files.Count
        Result(7) = "IsRootFolder: " & .IsRootFolder
        Result(8) = "Name: " & .Name
        Result(9) = "ParentFolder: " & .ParentFolder
        Result(10) = "Path: " & .Path
        Result(11) = "ShortName: " & .ShortName
        Result(12) = "ShortPath: " & .ShortPath
        Result(13) = "Size: " & .Size
        Result(14) = "SubFolders.Count: " & .SubFolders.Count
        Result(15) = "Type: " & .Type
    End With
    ReDim Preserve Result(1 To 15)
    GetFolderProperties = Join(Result, vbCrLf)
End Function

Các phương thức của đối tượng Folder: Copy, CreateTextFile, Delete, Move
Sub FolderMethods()
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim oFolder As Folder
    Set oFolder = FSo.GetFolder(ThisWorkbook.Path)
    'oFolder.Copy(Destination As String, [OverWriteFiles As Boolean = True])
    'oFolder.CreateTextFile(FileName As String, [OverWrite As Boolean = True], [Unicode As Boolean = False]) As TextStream
    'oFolder.Delete(Force As Boolean = False])
    'oFolder.Move(Destination As String)
    
    oFolder.Copy "D:\", True
End Sub 
   

2.19. GetParentFolderName
FSo.GetParentFolderName(Path As String) As String

Trả về đường dẫn của thư mục chính (thư mục cha) của thành phần cuối cùng trong một đường dẫn chỉ định đưa vào.
Path: Bắt buộc. Là đường dẫn của một tập tin hoặc một thư mục chỉ định.
Ví dụ:
Sub GetParentFolderName()
'FSo.GetParentFolderName(Path As String) As String
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim sFolder As String
    sFolder = FSo.GetParentFolderName(ThisWorkbook.FullName)
    'sFolder = FSo.GetParentFolderName(ThisWorkbook.Path)
    MsgBox sFolder
End Sub

2.20. GetSpecialFolder
FSo.GetSpecialFolder(SpecialFolder as SpecialFolderConst) As Folder

Trả về đối tượng Folder (thư mục) đặc biệt của hệ điều hành Windows.
SpecialFolder: Bắt buộc. Là hằng số tương ứng với thư mục đặc biệt của Windows.
0 = WindowsFolder     – Contains files installed by the Windows operating system
1 = SystemFolder       – Contains libraries, fonts, and device drivers
2 = TemporaryFolder   – Used to store temporary files

Ví dụ:
Sub GetSpecialFolder()
'FSo.GetSpecialFolder(SpecialFolder as SpecialFolderConst) As Folder
    'SpecialFolderConst:
        '0=WindowsFolder - Contains files installed by the Windows operating system
        '1=SystemFolder - Contains libraries, fonts, and device drivers
        '2=TemporaryFolder - Used to store temporary files
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim specFolder As Folder
    Set specFolder = FSo.GetSpecialFolder(0)
    MsgBox specFolder.Name  'Windows
End Sub

2.21. GetTempName
FSo.GetTempName

Trả về tên một tập tin *.tmp ngẫu nhiên.

Ví dụ:
Sub GetTempName()
'FSo.GetTempName
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim tmpFile As String, specFolder As Folder
    Set specFolder = FSo.GetSpecialFolder(2)
    tmpFile = FSo.GetTempName
    MsgBox tmpFile
    'specFolder.CreateTextFile (tmpFile) 'Create a temp file in the "Temp" folder.
End Sub

2.22. MoveFile

FSo.MoveFile(Source As String, Destination As String)

Di chuyển một hoặc nhiều tập tin (Files) tới địa chỉ chỉ định.
Sourve: Bắt buộc. Tên của môt hoặc nhiều tập tin cần di chuyển, có thể sử dụng ký tự đại diện (*?).
Destination: Đường dẫn địa chỉ cần di chuyển tới. Không thể sử dụng ký tự đại diện.
Ví dụ:
Sub MoveFile()
'FSo.MoveFile(Source As String, Destination As String)
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim sFiles As String, dPath As String
    sFiles = "D:\Example\*.txt"
    dPath = "E:\NewFolder"
    FSo.MoveFile sFiles, dPath
End Sub

2.23. MoveFolder

FSo.MoveFolder(Sourve As String, Destination As String)

Di chuyển một hoặc nhiều thư mục (Folders) tới địa chỉ chỉ định.
Sourve: Bắt buộc. Tên của môt hoặc nhiều thư mục cần di chuyển, có thể sử dụng ký tự đại diện (*?).
Destination: Đường dẫn địa chỉ cần di chuyển tới. Không thể sử dụng ký tự đại diện.
Ví dụ:
Sub MoveFolder()
'FSo.MoveFolder(Sourve As String, Destination As String)
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim sFolders As String, dPath As String
    sFolders = "D:\Example2\*"
    dPath = "E:\NewFolder2"
    FSo.MoveFolder sFolders, dPath
End Sub

2.24. OpenTextFile

FSo.OpenTextFile(FileName As String, [IOMode As IOMode = ForReading], [Create As Boolean = False], [Format As Tristate = TristateFalse]) as TextStream

Mở ra một tệp được chỉ định và trả về một đối tượng TextStream có thể được sử dụng để truy cập tập tin đó.
FileName: Bắt buộc. Là đường dẫn của tập tin cần mở.
IOMode: Không bắt buộc. Thiết lập kiểu mở tập tin. Mặc định là ForReading.
1 = ForReading – Mở một tập tin để đọc. Không thể ghi thêm nội dung vào tập tin
2 = ForWriting – Mở một tập tin để ghi thêm nội dung.
8 = ForAppending – Mở một tập tin và ghi vào cuối của tập tin.
Create: Không bắt buộc. Thiết lập liệu một tập tin mới có thể được tạo ra nếu tên tập tin đưa vào không tồn tại. True tức là tạo một tập tin mới, False không tạo một tập tin mới. Mặc định là False.
Format: Không bắt buộc. Là định dạng mở tập tin.
0 = TristateFalse – Mở tệp dưới dạng ASCII. Đây là giá trị mặc định.
-1 = TristateTrue – Mở tập tin dưới dạng Unicode.
-2 = TristateUseDefault – Mở tập tin bằng cách sử dụng hệ thống mặc định.
Ví dụ:
Sub OpenTextFile()
'FSo.OpenTextFile(FileName As String, [IOMode As IOMode = ForReading], [Create As Boolean = False], [Format As Tristate = TristateFalse]) as TextStream
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim txtFile As TextStream, sText As String
    Set txtFile = FSo.OpenTextFile("D:\Test1.txt", ForReading, False, TristateUseDefault)
    sText = txtFile.ReadAll
    txtFile.Close
    MsgBox sText
End Sub

Public Function ReadTextFile(ByVal pathTextFile As String) As String
    Dim FSo As Object
    Dim txtFile As TextStream
    Dim sText As String
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Set txtFile = FSo.OpenTextFile(pathTextFile, 1, False, -2)
    sText = txtFile.ReadAll
    txtFile.Close
    ReadTextFile = sText
End Function

3. Thuộc tính

3.1. Thuộc tính Drives của FSo

FSo.Drives

Trả về một Collection, cung cấp chi tiết về tất cả các ổ đĩa (Drives) được gắn vào hệ thống, hoặc là vật lý hoặc là logic. Có 2 thuộc tính: Count và Item
Count: Trả về số ổ đĩa được gắn vào hệ thống. 
FSo.Drives.Count

Item: Trả về đối tượng ổ đĩa (Drive) theo Key chỉ định.
FSo.Drives.Item(Key) As Drive
Hoặc
FSo.Drives(Key) As Drive

Tương đương với phương thức GetDrive của FSo: FSo.GetDrive(DriveSpec As String) As Drive

Ví dụ:
Sub Drives()
'FSo.Drives:
    '1:
    'FSo.Drives.Count               'Tra ve so luong o dia gan vao he thong
    '2:
    'FSo.Drives.Item(Key) As Drive  'Tra ve doi tuong o dia theo key chi dinh
    'FSo.Drives(Key) As Drive       'Tra ve doi tuong o dia theo key chi dinh
    '= FSo.GetDrive(DriveSpec As String) As Drive       'Phuong thuc GetDrive cua FSo

    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim objDrive As Drive, countDrives As Long
    countDrives = FSo.Drives.Count
    MsgBox countDrives
    Set objDrive = FSo.Drives.Item("C:")
    MsgBox objDrive.DriveLetter
    'Or:
    'Set objDrive = FSo.Drives("C:")
    'Or:
    'Set objDrive =FSo.GetDrive ("C:\")
End Sub

3.2. Chú thích (*):

Hai thuộc tính của đối tượng Folder: Files và SubFolders trả về một Collection (mở mục 2.18).

a. Thuộc tính Files của Folder

objFolder.Files

Trả về một Collection, cung cấp tất cả các tập tin (Files) có trong thư mục đó.
Có 2 thuộc tính: Count và Item
Count: Trả về số lượng tập tin có trong thư mục đó.
objFolder.Files.Count

Item: Trả về đối tượng File theo Key chỉ định.
objFolder.Files.Item(Key) As File
'Hoặc:
objfolder.Files(Key) As File

Tương đương với phương thức GetFile của FSo: FSo.GetFile(FilePath As String) As File
Ví dụ:
Sub FolderProperties_Files()
'objFolder.Files:
    '1:
    'objFolder.Files.Count              'Tra ve so luong Files trong Folder
    '2:
    'objFolder.Files.Item(Key) As File  'Tra ve duoi tuong File theo Key chi dinh
    'objfolder.Files(Key) As File       'Tra ve duoi tuong File theo Key chi dinh
    '= FSo.GetFile(FilePath As String) As File  'Phuong thuc GetFile cua FSo

    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim objFolder As Folder, countFiles As Long
    Set objFolder = FSo.GetFolder(ThisWorkbook.Path)
    countFiles = objFolder.Files.Count
    MsgBox countFiles
End Sub

b. Thuộc tính SubFolders của Folder

objFolder.SubFolders

Trả về một Collection, cung cấp tất cả các thư mục (Folders) có trong thư mục đó.
– Có 1 phương thức: Add
    Tạo mới một Folder:
objFolder.SubFolders.Add(Name As String) As Folder

    Tương đương với phương thức CreateFolder của FSo: FSo.CreateFolder(Path As String) As Folder
– Có 2 thuộc tính: Count và Item
Count: Trả về số lượng Folders có trong Folder chỉ định đưa vào.
objFolder.SubFolders.Count

Item: Trả về đối tượng Folder theo Key chỉ định
objFolder.SubFolders.Item(Key) As Folder
'Hoặc:
objFolder.SubFolders(Key) As Folder

    Tương đương với phương thức GetFolder của FSo: FSo.GetFolder(FolderPath As String) As Folder        
Ví dụ:
Sub FolderProperties_SubFolders()
'objFolder.SubFolders:
    '1:
    'objFolder.SubFolders.Add(Name As String) As Folder     'Tao mot Folder
    '= FSo.CreateFolder(Path As String) As Folder           'Tuong duong voi phuong thuc CreateFolder cua FSo
    '2:
    'objFolder.SubFolders.Count                             'Tra ve so luong Folders co trong Folder dang xet
    '3:
    'objFolder.SubFolders.Item(Key) As Folder               'Tra ve duoi tuong Folder theo Key chi dinh
    'objFolder.SubFolders(Key) As Folder                    'Tra ve duoi tuong Folder theo Key chi dinh
    '= FSo.GetFolder(FolderPath As String) As Folder        'Tuong duong voi phuong thuc GetFolder cua FSo
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim objFolder As Folder, countFolders As Long, oFolder As Folder, sFolder As String
    Set objFolder = FSo.GetFolder(ThisWorkbook.Path)
    sFolder = "NewFolder2"
    countFolders = objFolder.SubFolders.Count
    If FSo.FolderExists(objFolder.Path & "\" & sFolder) = False Then
        objFolder.SubFolders.Add sFolder
    End If
    Set oFolder = objFolder.SubFolders.Item(sFolder)
    If objFolder.SubFolders.Count > countFolders Then
        MsgBox "The new folder is: " & oFolder.Name
    End If
End Sub

4. Một số Sub/ Function

'// Tra ve chuoi la noi dung cua text file theo duong dan chi dinh
Public Function ReadTextFile(ByVal pathTextFile As String) As String
    Dim FSo As Object, txtFile As TextStream, sText As String
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Set txtFile = FSo.OpenTextFile(pathTextFile, 1, False, -2)
    sText = txtFile.ReadAll
    txtFile.Close
    ReadTextFile = sText
End Function

'// Tra ve danh sach Files trong mot Folder chi dinh, theo kieu loai File chi dinh (co the su dung ky tu dai dien *?)
'typeName=0: Tra ve danh sach ten cua File (File.Name, gom phan mo rong cua File)
'typeName=1: Tra ve danh sach ten co so cua File (BaseName, khong gom phan mo rong cua File)
'typeName=2: Tra ve danh sach duong dan day du cua File (File.Path)
'typeName=3: Tra ve danh sach duong dan rut gon cua File (File.ShortPath)
Public Function GetFilesInFolder(ByVal pathFolder As String, ByVal extensionFile As String, Optional ByVal typeName As Byte = 0)
    Dim FSo As Object, objFolder As Folder, objFile As File, Result(), i As Long
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Set objFolder = FSo.GetFolder(pathFolder)
    extensionFile = VBA.UCase(extensionFile)
    For Each objFile In objFolder.Files
        If VBA.UCase(FSo.GetExtensionName(objFile)) Like extensionFile Then
            i = i + 1
            ReDim Preserve Result(1 To i)
            Select Case typeName
                Case 0
                    Result(i) = objFile.Name
                Case 1
                    Result(i) = FSo.GetBaseName(objFile.Path)
                Case 2
                    Result(i) = objFile.Path
                Case 3
                    Result(i) = objFile.ShortPath
            End Select
         End If
    Next objFile
    GetFilesInFolder = Result
End Function

'// Tra ve duong dan day du cua Folder duoc chon. Neu khong chon thi tra ve chuoi rong (len(chuoi)=0)
Public Function GetPathFolder(ByVal pathFolder As String) As String
    Dim fDlog As FileDialog, sItem As String
    Set fDlog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDlog
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = pathFolder
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetPathFolder = sItem
    Set fDlog = Nothing
End Function

'// Xoa Files trong Folder chi dinh, loai File chi dinh (co the su dung ky tu dai dien *?)
'=== Ghi chu: Can trong khi su dung ===
Public Sub DeleteFiles(ByVal pathFolder As String, ByVal extensionFile As String, Optional ByVal Force As Boolean = False)
    Dim FSo As Object, objFile As File
    Set FSo = CreateObject("Scripting.FileSystemObject")
    extensionFile = VBA.UCase(extensionFile)
    With FSo.GetFolder(pathFolder)
      For Each objFile In .Files
         If VBA.UCase(FSo.GetExtensionName(objFile)) Like extensionFile Then
            FSo.DeleteFile objFile, Force
         End If
      Next objFile
   End With
End Sub

'// Xoa tat ca Folders trong Folder chi dinh
'=== Ghi chu: Can trong khi su dung ===
Public Sub DeleteFolders(ByVal pathFolder As String, Optional ByVal Force As Boolean = False)
    Dim FSo As Object, objFolder As Folder
    Set FSo = CreateObject("Scripting.FileSystemObject")
    With FSo.GetFolder(pathFolder)
      For Each objFolder In .SubFolders
            FSo.DeleteFolder objFolder, Force
      Next
   End With
End Sub

'// Xoa tat ca Files va Folders trong Folder chi dinh
'=== Ghi chu: Can trong khi su dung ===
Public Sub DeleteAll(ByVal pathFolder As String, Optional ByVal Force As Boolean = False)
    Dim FSo As Object, objFolder As Folder, objFile As File
    Set FSo = CreateObject("Scripting.FileSystemObject")
    With FSo.GetFolder(pathFolder)
      For Each objFolder In .SubFolders
            FSo.DeleteFolder objFolder, Force
      Next
      For Each objFile In .Files
         FSo.DeleteFile objFile, Force
      Next objFile
   End With
End Sub

Tải file ví dụ: FileSystemObject

Join LeQuocThai.Com on Telegram Channel

Lê Quốc Thái
Lê Quốc Tháihttps://lequocthai.com/
Yep! I am Le Quoc Thai codename name tnfsmith, one among of netizens beloved internet precious, favorite accumulate sharing all my knowledge and experience Excel, PC tips tricks, gadget news during over decades working in banking data analysis.

1 BÌNH LUẬN

BÌNH LUẬN

Vui lòng nhập bình luận của bạn
Vui lòng nhập tên của bạn ở đây

Join LeQuocThai.Com on Telegram Channel

Đọc nhiều nhất

BÀI VIẾT MỚI NHẤT

CÙNG CHỦ ĐỀ