Bài 12. FileSystemObject

[befaint]

Bài 12. FileSystemObject

(Danh sách các bài viết về VBA xem ở đây Index - Các bài viết về VBA)

FileSystemObject (FSo) là một phần trong thư viện Microsoft Scripting Runtime (scrrun.dll), là công cụ xử lý về Drive, Folder, File. Nội dung chính gồm:
#1
1. Khai báo
2. Các phương thức
2.1. BuildPath
2.2. CopyFile
2.3. CopyFolder
2.4. CreateFolder
2.5. CreateTextFile
2.6. DeleteFile
2.7. DeleteFolder
2.8. DriveExists
2.9. FileExists
2.10. FolderExists
#2
2.11. GetAbsolutePathName
2.12. GetBaseName
2.13. GetDrive
2.14. GetDriveName
2.15. GetExtensionName
2.16. GetFile
2.17. GetFileName
2.18. GetFolder
2.19. GetParentFolderName
2.20. GetSpecialFolder
2.21. GetTempName
2.22. MoveFile
2.23. MoveFolder
2.24. OpenTextFile
3. Thuộc tính
3.1. Thuộc tính Drives của FSo
3.2. Thuộc tính Files và SubFolders của Folder
#3
4. Một số Sub/ Function
-------------------------------

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

------------
{còn tiếp}

 

[befaint]

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

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. Thuộc tính Files và SubFolders của Folder (chú thích "*")
Hai thuộc tính của đối tượng Folder: Files và SubFolders trả về một Collection (ở 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

------------
{còn tiếp}

 

[befaint]

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 Object, 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 Object, objFile As Object, 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 Object
    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 Object
    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 Object, objFile As Object
    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

 

[huuthang_bd]

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

Nếu thư mục mẹ không tồn tại thì sẽ báo lỗi. Vì vậy, cần kiểm tra sự tồn tại của thư mục mẹ nữa. Nếu là tôi thì tôi sẽ tạo thư mục như thế này

Private Function CreateFolder(ByVal sPath As String, ByRef FSo As Object) As Boolean
If sPath = "" Then Exit Function
If FSo.FolderExists(sPath) Then
    CreateFolder = True
Else
    CreateFolder = CreateFolder(FSo.GetParentFolderName(sPath), FSo)
    If CreateFolder Then FSo.CreateFolder sPath
End If
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub TestCreateFolder()
    Dim FSo As Object
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Debug.Print CreateFolder("D:\A\B\C\D\E\F\G\H", FSo)
    Debug.Print CreateFolder("TaoLao:\A\B\C\D\E\F\G\H", FSo)
End Sub

Các phương thức khác như CopyFile, CopyFolder,... muốn chắc ăn thì cứ CreateFolder kiểu như trên trước khi thực hiện.

sPath = FSo.GetAbsolutePathName(ThisWorkbook.Name)

Ví dụ này thì sơ sài quá, kết quả trả về không biết để làm gì. Còn nếu muốn lấy đường dẫn đầy đủ thì tôi viết vầy cho chắc ăn

sPath  = ThisWorkbook.FullName

2.12. GetBaseName
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.

Không nên tin vào cái này nha. Thử cái này là biết ngay.

?CreateObject("Scripting.FileSystemObject").GetBaseName("D:\05.09.2017")

Vì vậy đoạn sau cũng chưa đúng:

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

4. Một số Sub/ Function

ReadTextFile tôi nghĩ không dùng được cho file Unicode
GetPathFolder thì tôi nghĩ viết vầy cũng được:

Public Function GetPathFolder(ByVal pathFolder As String) As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = pathFolder
        If .Show Then GetPathFolder = .SelectedItems(1)
    End With
End Function

Các hàm xóa thì nếu Force = False thì phải kiểm tra thuộc tính của File/Folder hoặc thêm dòng bỏ qua lỗi. Còn nếu xóa hết không quan tâm thuộc tính Read-Only thì tôi nghĩ vầy cũng được:

Public Sub DeleteFiles(ByVal pathFolder As String, ByVal extensionFile As String)
    CreateObject("Scripting.FileSystemObject").DeleteFile pathFolder & "\*." & extensionFile, True
End Sub

Bài 14 chắc là Regular Expression nhỉ

 

[Kiều Mạnh]

To @befaint ........... Mạnh đọc thấy còn thiếu 2 công cụ nữa Ghóp vui thêm với Bạn cho đủ bộ ... ta làm thư viện tra cứu và sử dụng khi cần thiết

Rem ==========
Sub GetFileShortPath()
    Dim Fso, f, myFile
    Set Fso = CreateObject("Scripting.FileSystemObject")
    'myFile = ThisWorkbook.Path & "\xcopy.xls"
    myFile = ThisWorkbook.FullName
    Set f = Fso.GetFile(myFile)
    MsgBox "Short name = " & f.ShortPath
End Sub
Rem ==========
Sub GetFolderShortPath()
    Dim Fso, f, myFolder
    Set Fso = CreateObject("Scripting.FileSystemObject")
    'myFolder = "E:\New folder"
    myFolder = ThisWorkbook.Path
    Set f = Fso.GetFolder(myFolder)
    MsgBox "Short pathname = " & f.ShortPath
End Sub

Ôi giàng oi mới coi lại nó trong Hàm này GetFolderProperties ................ thui để vậy đi cho dễ hiểu

 

[ndu96081631]

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 đã có (tạo một chuỗi là đường dẫn).
Path: Bắt buộc. Đường dẫn để nối tên vào, đã tồn tại.
Name: Bắt buộc. Tên cần nối vào đường dẫn chỉ định.

Đã tồn tại nghĩa là sao? Tôi không hiểu!
- Là Path bắt buộc phải là 1 đường dẫn tồn tại?
- Là đối số Path bắt buộc phải ghi?
Hay là sao?

 

[befaint]

Đã tồn tại nghĩa là sao? Tôi không hiểu!
- Là Path bắt buộc phải là 1 đường dẫn tồn tại?
- Là đối số Path bắt buộc phải ghi?
Hay là sao?

Trong quá trình soạn bài có những chỗ chưa hoàn chỉnh và chưa đúng (...), anh chỉnh giúp em với.
Nội dung còn một số bài tiếp, anh nhớ dành thời gian xem và chỉnh lại giúp em nhé.
Cảm ơn anh.

 

[ndu96081631]

Trong quá trình soạn bài có những chỗ chưa hoàn chỉnh và chưa đúng (...), anh chỉnh giúp em với.
Nội dung còn một số bài tiếp, anh nhớ dành thời gian xem và chỉnh lại giúp em nhé.
Cảm ơn anh.

Tôi xin nói thêm chỗ BuidPath (theo sự hiểu biết của cá nhân)
- Ngày trước, khi muốn nối chuỗi đường dẫn và tên file để ra một đường dẫn đầy đủ, các lập trình viên thường viết:

If Right(sFolder,1) <> "\" then sFolder = sFolder & "\"

mục đích để chắc ăn cái sFolder này luôn kết thúc bằng ký tự "\". Sau đó nối với tên file thì chỉ cần:

sPath = sFolder & sFile

- Sau này cái BuidPath trong FileSystemObject đã làm luôn công đoạn trên cho người dùng. Tức chỉ cần truyền vào đường dẫn thư mục + tên file là nó ra luôn 1 đường dẫn đầy đủ và đúng cú pháp (bất chấp đường dẫn thư mục có kết thúc bằng dấu "\" hay không)

 

[Kiều Mạnh]

Mạnh có File Tổng hợp FileSystemObject của Tây nó viết cũng chi tiết lắm .......... Úp lên đây cho Bạn nào cần nghiên cứu thêm ... đồng thời Mạnh lưu chung hết Fso vào đây ... Ngộ nhỡ mai mốt có xuất qua Mỹ ở thì cứ chuôi vào đây lấy cho nó Tiện ... có nơi lưu dùm Miễn Phí he .............

 

[VetMini]

Góp ý về cách trình bày bài

Bài #1 của bạn ở đây khá dài. Người chưa quen đọc hơi khó hiểu. Tôi đề nghị bạn nên cho một cái bảng tóm lược ngay ở đầu bài. Đại khái như sau:

Sơ lược (giới thiệu):
File System Object là ... (khoảng 60-100 từ)

Các điểm được trình bày trong bài #1 này:
1. Khai báo
1.1 Khai báo theo kiểu dữ liệu đã xác định
1.2 Khai báo theo phương pháp kết nối trễ
1. Các thuộc tính căn bản:
1.1 ...
2. Các phương thức căn bản:
2.1 BuildPath
2.2 ...
3. Các hướng dẫn sử dụng:
3.1 ...

Sau khi có bảng tóm lược rồi, bạn mới bắt đầu vào chi tiết từng mục. Như vậy người đọc có thể liếc sơ qua và biết mình có thể tìm được gì, thay vì phải đọc đến hết bài.
Đương nhiên là dùng từ khóa thì chính trình duyệt sẽ tìm được, nhưng khi viết bài, bạn cũng phải đặt trường hợp người đọc chưa quen thuộc với vấn đề và khong biết từ khóa.

 

[babyheomoi]

Bài viết cũng rất hay và tương đối dể hiểu cho người mới,em góp ý nếu có ví dụ nữa sẽ hoàn chỉnh hơn.
Lưu để học!

 

[hung2412]

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

Tôi thử làm lệnh Copy File từ máy trong mạng Lan sang máy của tôi, nhưng nó báo lỗi là "Permission denied". Như vậy là không được phép copy File từ máy trong mạng Lan về máy mình phải không nhỉ?

 

[truongvu317]

Tôi thử làm lệnh Copy File từ máy trong mạng Lan sang máy của tôi, nhưng nó báo lỗi là "Permission denied". Như vậy là không được phép copy File từ máy trong mạng Lan về máy mình phải không nhỉ?
View attachment 254737

copy bằng tay có thực hiện được không? code tính sau.

 

[hung2412]

copy bằng tay có thực hiện được không? code tính sau.

Copy bằng tay thì nói làm gì bạn, Code mới là phương án tối ưu.

 

[hung2412]

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

Chỗ này dPath = "D:\Vidu" => Sửa thành như thế này dPath = "D:\Vidu\" thì mới được
Phải thêm dấu \ sau Vidu