VBA: 利用FileSystemObject对象来处理文件

文章背景： 在VBA中，通过Dir函数，可以判断指定路径的文件是否存在等。此外，借助FileSystemObject对象，我们同样可以操作文件和文件夹。

FileSystemObject对象模型，是微软提供的专门用来访问计算机文件系统的，具有大量的属性和方法。其使用面向对象的“object.method”语法来处理文件夹和文件，使用起来十分方便。FileSystemObject并不是VBA的一部分，它是以一个COM组件的形式提供的。因此，使用前要创建FileSystemObject对象。

1 创建FSO对象

1.1 直接创建法

1.2 引用法

2 借助FSO可以获取的对象

3 FSO对象的属性

4 应用示例

4.1 检查文件或文件夹是否存在

4.2 基于给定路径，创建新文件夹

4.3 获取文件夹内所有文件的名称

4.4 获取文件夹内所有子文件夹的名称

4.5 获取文件夹及其子文件夹内所有文件的名称

4.6 拷贝文件

4.7 拷贝文件夹

1 创建FSO对象

1.1 直接创建法

代码语言：javascript复制

Sub FSODemo()

    Dim FSO As Object
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
End Sub

A big downside of using this method is that it would not show an IntelliSense when you work with objects in FSO.

使用直接创建法的缺点是，在VBA代码中，在使用FSO对象时，无法使用自动补全代码的功能。

1.2 引用法

通过VBE编译器里的工具->引用，打开引用对话框，在可使用的引用中，找到Microsoft Scripting Runtime选项，点击确定。具体操作如下：

http://mpvideo.qpic.cn/0bc344aacaaav4ajpe3xurrfbz6dahtqaaia.f10002.mp4?dis_k=8acb6ee50c2919d41a387dab6ccb8ba0&dis_t=1663656429&vid=wxv_2389279455514099713&format_id=10002&support_redirect=0&mmversion=false

完成上述步骤之后，接下来就可以在VBA代码中引用FSO对象。

代码语言：javascript复制

Sub CreatingFSO()

    Dim MyFSO As FileSystemObject
    
    Set MyFSO = New FileSystemObject
    
End Sub

(1) 通过New关键字，创建FileSystemObject的实例（Instance）。

(2) 通过Set关键字，将这个FileSystemObject的新实例赋给MyFSO对象。

如果需要的话，可以将上述的两条代码整合为一条。

代码语言：javascript复制

Sub CreatingFSO_1()

    Dim MyFSO As New FileSystemObject
    
End Sub

采用引用法的好处是，在代码中使用FSO对象时，可以通过代码自动补全的功能，显示FSO对象的属性和方法。

http://mpvideo.qpic.cn/0b2e24aaaaaalyajnx3xurrfbv6dadlqaaaa.f10002.mp4?dis_k=a42b0beb9b84c8710e8028114e1cfb8e&dis_t=1663656429&vid=wxv_2389280549808013313&format_id=10002&support_redirect=0&mmversion=false

2 借助FSO可以获取的对象

下表展示了借助FSO可以获取和修改的几个重要的对象。

3 FSO对象的属性

4 应用示例

假如C盘中有如下的文件结构：

代码语言：javascript复制

#   a ->  b  ->  1dog.txt, 2cat.txt
#          c  ->  3panda.txt
#          d  ->  e
#          4duck.txt
#          5horse.txt

4.1 检查文件或文件夹是否存在

（1）检查指定路径的文件夹是否存在

代码语言：javascript复制

Sub CheckFolderExist()

    Dim MyFSO As FileSystemObject
    
    Set MyFSO = New FileSystemObject
    
    If MyFSO.FolderExists("C:ab") Then
    
        Debug.Print "The Folder Exists."
        
    Else
    
        Debug.Print "The Folder Does Not Exist."
        
    End If
    
End Sub

运行后，立即窗口中显示的是：

代码语言：javascript复制

The Folder Exists.

VBA中的Dir函数，可以实现类似的功能，用到的主要代码为：CheckDir = Dir(PathName, vbDirectory)。

（2）检查指定路径的文件是否存在

代码语言：javascript复制

Sub CheckFileExist()

    Dim MyFSO As FileSystemObject
    
    Set MyFSO = New FileSystemObject
    
    If MyFSO.FileExists("C:ac3panda.txt") Then
    
         Debug.Print "The File Exists."
        
    Else
    
         Debug.Print "The File Does Not Exist."
        
    End If
    
End Sub

运行后，立即窗口中显示的是：

代码语言：javascript复制

The File Exists.

VBA中的Dir函数，可以实现类似的功能，用到的主要代码为：FileName = Dir(Path)。

4.2 基于给定路径，创建新文件夹

代码语言：javascript复制

Sub CreateFolder()

    Dim MyFSO As FileSystemObject
    
    Set MyFSO = New FileSystemObject
    
    If MyFSO.FolderExists("C:af") Then
    
        Debug.Print "The Folder Already Exist"
        
    Else
    
        MyFSO.CreateFolder ("C:af")
        
    End If
    
End Sub

由于文件夹f一开始不存在，因此，运行代码后，创建新的文件夹f。

（1）通过MyFSO.FolderExists判断文件夹是否存在；若不存在，则通过MyFSO.CreateFolder创建新的文件夹。

（2）也可以通过VBA的Dir函数判断文件夹是否存在；若不存在，则通过MkDir函数创建新的文件夹。

4.3 获取文件夹内所有文件的名称

代码语言：javascript复制

Sub GetFileNames()

    Dim MyFSO As FileSystemObject
    Dim MyFile As File
    Dim MyFolder As Folder

    Set MyFSO = New FileSystemObject
    Set MyFolder = MyFSO.GetFolder("C:a")

    For Each MyFile In MyFolder.Files
    
        Debug.Print MyFile.Name
        
    Next MyFile

End Sub

运行后，立即窗口中显示的是：

代码语言：javascript复制

4duck.txt
5horse.txt

此外，借助VBA中的Dir函数，以及Do...Loop循环，也可以实现类似的功能。

4.4 获取文件夹内所有子文件夹的名称

代码语言：javascript复制

Sub GetSubFolderNames()

    Dim MyFSO As FileSystemObject
    Dim MyFile As File
    Dim MyFolder As Folder
    Dim MySubFolder As Folder

    Set MyFSO = New FileSystemObject
    Set MyFolder = MyFSO.GetFolder("C:a")

    For Each MySubFolder In MyFolder.SubFolders
    
        Debug.Print MySubFolder.Name
        
    Next MySubFolder

End Sub

运行后，立即窗口中显示的是：

代码语言：javascript复制

b
c
d
f

此外，借助VBA中的Dir函数，以及Do...Loop循环，也可以实现类似的功能。

4.5 获取文件夹及其子文件夹内所有文件的名称

通过递归法，使用FSO对象获取文件夹及其子文件夹内所有文件的名称。

代码语言：javascript复制

Sub getAllFileNames()

    Dim MyFSO As FileSystemObject
    Dim MyFolder As Folder

    Set MyFSO = New FileSystemObject
    
    If MyFSO.FolderExists("C:a") Then
    
        Set MyFolder = MyFSO.GetFolder("C:a")
        
        LookupAllFiles MyFolder
        
    Else
    
        Debug.Print "The Folder Does Not Exist."
    
    End If
    
End Sub

Sub LookupAllFiles(fld As Folder)

    Dim fil As File, outFld As Folder
    
    For Each fil In fld.Files
    
        Debug.Print fil.Name
        
    Next
    
    For Each outFld In fld.SubFolders
    
        LookupAllFiles outFld   '递归法，调用自身
    
    Next
    
End Sub

运行getAllFileNames的代码，立即窗口中显示的是：

代码语言：javascript复制

4duck.txt
5horse.txt
1dog.txt
2cat.txt
3panda.txt

4.6 拷贝文件

把一个或多个文件从一个地方复制到另一个地方。

object.CopyFile source, destination, [ overwrite ]

source -- Required. Character string file specification, which can include wildcard characters, for one or more files to be copied.
destination -- Required. Character string destination where the file or files from source are to be copied. Wildcard characters are not allowed.
overwrite -- Optional. Boolean value that indicates if existing files are to be overwritten. If True, files are overwritten; if False, they are not. The default is True. Note that CopyFile will fail if destination has the read-only attribute set, regardless of the value of overwrite. 关于通配符的使用，说明如下： Wildcard characters can only be used in the last path component of the source argument. For example, you can use: FileSystemObject.CopyFile "c:ab*.txt", "c:a" But you can't use: FileSystemObject.CopyFile "c:a**.txt", "c:a" 更多关于object.CopyFile用法的注意事项，参见文末的参考资料[6]。

4.6.1 拷贝单个文件

代码语言：javascript复制

Sub CopyFile()

    Dim MyFSO As FileSystemObject
    Dim Source As String
    Dim Destination As String
    
    Set MyFSO = New FileSystemObject

    Source = "C:ab1dog.txt"
    Destination = "C:a1dog.txt"

    MyFSO.CopyFile Source, Destination

End Sub

上述代码仅仅作为示例使用。实际工作中，拷贝前，需要提前判断：1) Source文件是否存在；2) Destination路径中是否已存在同名文件。

4.6.2 拷贝多个指定类型的文件

代码语言：javascript复制

Sub CopyMoreFile()

    Dim MyFSO As FileSystemObject
    Dim Source As String
    Dim Destination As String
    Dim FileName As String
    
    Set MyFSO = New FileSystemObject

    Source = "C:ab*.txt"
    Destination = "C:a"
    
    FileName = Dir(Source)
    If FileName <> "" Then
    
        If MyFSO.FolderExists(Destination) Then
        
            On Error Resume Next
            MyFSO.CopyFile Source, Destination, False
        
            If Err.Number <> 0 Then
        
                Debug.Print "目标文件夹中存在同名文件，请确认！"
        
            End If
        
            On Error GoTo 0
            
        Else
        
            Debug.Print "目标文件夹不存在。"
        
        End If
        
    Else
    
        Debug.Print "未找到指定文件。"
        
    End If
    
    Debug.Print "Done."

End Sub

（1）借助通配符，可以实现一次性拷贝多个指定文件到指定文件夹内。

（2）如果 source 中包含通配符或 destination中以路径分隔符（）为结尾，则认为 destination 是一个已存在文件夹，在其中复制相匹配的文件。

4.7 拷贝文件夹

Recursively copies a folder from one location to another.

object.CopyFolder source, destination, [ overwrite ]

source -- Required. Character string folder specification, which can include wildcard characters, for one or more folders to be copied.
destination -- Required. Character string destination where the folder and subfolders from source are to be copied. Wildcard characters are not allowed.
overwrite -- Optional. Boolean value that indicates if existing folders are to be overwritten. If True, files are overwritten; if False, they are not. The default is True. 更多关于object.CopyFolder用法的注意事项，参见文末的参考资料[8]。

4.7.1 拷贝单个文件夹

代码语言：javascript复制

Sub CopyFolder()

    Dim MyFSO As FileSystemObject
    Dim Source As String
    Dim Destination As String
    
    Set MyFSO = New FileSystemObject

    Source = "C:ab"
    Destination = "C:ad"

    MyFSO.CopyFolder Source, Destination, False
    
    Debug.Print "Done."

End Sub

（1）上述代码将文件夹b拷贝到文件夹d内。

（2） If source contains wildcard characters, or destination ends with a path separator (), it is assumed that destination is an existing folder in which to copy matching folders and subfolders.

4.7.2 拷贝多个文件夹

代码语言：javascript复制

Sub CopyMoreFolder()

    Dim MyFSO As FileSystemObject
    Dim Source As String
    Dim Destination As String
    
    Set MyFSO = New FileSystemObject

    Source = "C:ad*"
    Destination = "C:a"
    
    If Not MyFSO.FolderExists(Destination) Then
    
        Debug.Print "目标文件夹不存在。"
        
        Exit Sub
    
    End If
    
    On Error Resume Next
    MyFSO.CopyFolder Source, Destination, False
    
    If Err.Number <> 0 Then Debug.Print "匹配不到文件夹，或者目标文件夹内已存在同名文件夹。"
    
    On Error GoTo 0
    
    Debug.Print "Done."

End Sub

（1）将文件夹d内所有的子文件夹拷贝到文件夹a内，本例中文件夹d内只有一个子文件夹，也就是e。

（2）如果 source 中包含通配符，则认为 destination 是一个已存在的文件夹。如果destination 文件夹不存在，则运行时会报错：Run-time error '76': Path not found。

参考资料：

[1] excel VBA 操作文件的主要方法利用FileSystemObject对象来处理文件(https://www.office26.com/excelhanshu/vba-read-write-files-03.html)

[2] Excel VBA 操作文件（夹）神器--FSO对象(https://zhuanlan.zhihu.com/p/104704524)

[3] FileSystemObject object(https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/filesystemobject-object)

[4] Using VBA FileSystemObject (FSO) in Excel – Easy Overview & Examples(https://trumpexcel.com/vba-filesystemobject/)

[5] How to use the MKDIR Statement (VBA)(https://www.techonthenet.com/excel/formulas/mkdir.php)

[6] CopyFile method(https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/copyfile-method)

[7] VBA中CopyFile 方法的功能及应用(https://blog.csdn.net/kongwei521/article/details/7176558)

[8] CopyFolder method(https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/copyfolder-method)

延伸阅读：

[1] VBA: Dir函数查找指定文件

[2] VBA: 使用递归法将xls文件批量转化为xlsm文件

网络安全 https 文件存储 vba 编程算法

0 人点赞