使用VBA操作文件(11):处理文件、文件夹和驱动器的VBA技术和技巧

 

如果希望处理文件或文件系统，有几种选择可用。最好的选择取决于您希望完成什么任务。可用的选择包括使用VBA函数、Microsoft Scripting Runtime对象库、FileSearch对象，以及与文件系统相关的Windows API函数。
使用VBA函数
可以使用许多VBA函数处理文件系统，下表对这些函数进行了总结。

VBA函数或语句 说明

Dir	返回与指定的格式或文件属性相匹配的文件、目录或文件夹的名称。
GetAttr	返回文件、目录或文件夹的属性。
SetAttr	指定文件、目录或文件夹的属性。
CurDir	返回当前目录。
ChDir	修改当前目录。
ChDrive	修改当前驱动器。
MkDir	创建一个新目录。
RmDir	移除一个现有的目录。
Kill	删除一个或多个文件。
FileLen	以字节返回磁盘中文件的长度。
LOF	以字节返回一个打开文件的长度。
FileCopy	复制磁盘中的文件。
FileDateTime	返回文件创建或最后修改的日期和时间。
Name	重命名文件并将其移动到磁盘中另一个位置。
Open	打开磁盘中的文件来读取或写入。
Input	从打开的文件中读取字符。
Print	写文本到顺序文件中。
Write	写文本到顺序文件中。
Close	关闭使用Open语句打开的文件。

 

 

如何使用Dir函数判断某文件是否存在？
Dir函数返回在pathname参数中指定的文件的名称。通常使用Dir函数来判断是否指定的文件存在，例如下面的DoesFileExist函数：

Function DoesFileExist(strFileSpec As String) As Boolean

' 如果参数strFileSpec指定的文件存在则返回True.

' 如果strFileSpec不是有效的文件或者是一个目录则返回False.

Const INVALID_ARGUMENT As Long = 53

On Error GoTo DoesfileExist_Err

 If (GetAttr(strFileSpec) And vbDirectory) <> vbDirectory Then

 DoesFileExist = CBool(Len(Dir(strFileSpec)) > 0)

 Else DoesFileExist = False

 End If

DoesfileExist_End:

 Exit Function DoesfileExist_Err:

DoesFileExist = False

 Resume DoesfileExist_End

 End Function

本例中，GetAttr函数用于确保strFileSpec参数中的值不是一个目录。这是因为，如果向Dir函数中传递一个有效的目录名称，那么将返回在该目录中找到的第一个文件。
如何使用Dir函数获取文件夹中所有文件的名称？
如果pathname参数包含文件夹的路径而不是文件夹中某文件的名称，那么Dir函数返回在该文件夹中找到的第一个文件的名称。接着，再调用Dir函数而无需任何参数，获取文件夹中后面每一个文件的名称。例如，下面的过程返回一个数组，包含在strDirPath参数中指定的目录内所有文件的名称：

Function GetAllFilesInDir(ByVal strDirPath As String) As Variant ' 遍历strDirPath中指定的目录并在数组中保存每个文件名 ' 然后返回该数组到调用过程. ' 如果strDirPath不是一个有效的目录则返回False. Dim strTempName As String Dim varFiles() As Variant Dim lngFileCount As Long   On Error GoTo GetAllFiles_Err   ' 确保strDirPath以"\"字符结尾. If Right$(strDirPath, 1) <> "\" Then strDirPath = strDirPath & "\" End If   ' 确保strDirPath是一个目录. If GetAttr(strDirPath) = vbDirectory Then strTempName = Dir(strDirPath, vbDirectory) Do Until Len(strTempName) = 0 ' 排除 ".", "..". If (strTempName <> ".") And (strTempName <> "..") Then ' 确保没有子目录名称. If (GetAttr(strDirPath & strTempName) _ And vbDirectory) <> vbDirectory Then ' 增加数组的大小以适应发现的文件名并将其添加到数组. ReDim Preserve varFiles(lngFileCount) varFiles(lngFileCount) = strTempName lngFileCount = lngFileCount + 1 End If End If ' 使用Dir函数查找下一个文件名. strTempName = Dir() Loop ' 返回包含已找到的文件名称的数组. GetAllFilesInDir = varFiles End If GetAllFiles_End: Exit Function GetAllFiles_Err: GetAllFilesInDir = False Resume GetAllFiles_End End Function

GetAllFilesInDir函数通过遍历目录中的每一项，并且对于发现的文件，将其名称添加到数组。第一次调用Dir时，使用目录名作为其参数。每增加一次调用都使用不带参数的Dir函数。该过程使用GetAttr函数来确保strDirPath参数包含一个有效的目录，也避免任何子目录的名称被添加到数组中。注意，该过程筛选出“.”和“..”，代表当前目录和父目录。
可以使用下面的过程测试GetAllFilesInDir过程。可以对strDirName参数试不同的值，然后使用F8逐行运行代码，看该过程是如何工作的。

Sub TestGetAllFiles() Dim varFileArray As Variant

 Dim lngI As Long Dim strDirName As String 

 Const NO_FILES_IN_DIR As Long = 9

 Const INVALID_DIR As Long = 13  

 On Error GoTo Test_Err  

strDirName = "c:\my documents"

varFileArray = GetAllFilesInDir(strDirName)

For lngI = 0 To UBound(varFileArray)

 Debug.Print varFileArray(lngI)

Next lngI  

 Test_Err:

Select Case Err.Number

Case NO_FILES_IN_DIR MsgBox "The directory named '" & strDirName _ & "' contains no files."

Case INVALID_DIR MsgBox "'" & strDirName & "' is not a valid directory."

Case 0 Case Else MsgBox "Error #" & Err.Number & " - " & Err.Description

End Select

End Sub

使用Microsoft Scripting Runtime Object Library
Microsoft Scripting Runtime对象库包含可以用于操作文件和目录的对象，并且比前面讲述的VBA函数更容易使用。
在使用该对象库之前，必须设置对该对象库的引用。如果在“引用”对话框中没有找到该对象库，那么应该可以在C:\Windows\System子文件夹中找到它（Scrrun.dll）。
下表描述了Scripting Runtime对象库是的对象。

对象 集合 描述

Dictionary		顶层对象，与VBA Collection集合对象相似。
Drive	Drives	引用系统中的驱动器或驱动器的集合。
File	Files	引用文件系统中的文件或文件集合。
FileSystemObject		顶层对象，用于访问驱动器、文件夹、文件。
Folder	Folders	引用文件系统中的文件夹或文件夹集合。
TextStream		引用读取、写入或追加到文本文件中的一系列文本。

 

 

在Scripting Runtime对象库中的顶层对象是Dictionary对象和FileSystemObject对象。要使用Dictionary对象，则需创建一个Dictionary类型的对象变量，然后设置其为Dictionary对象的新实例。

Dim dctDict As Scripting.Dictionary Set dctDict = New Scripting.Dictionary

要在代码中使用Scripting Runtime库中的其它对象，必须首先创建FileSystemObject类型的变量，然后使用New关键词创建该FileSystemObject对象的新实例，如下面的代码所示：

Dim fsoSysObj As Scripting.FileSystemObject Set fsoSysObj = New Scripting.FileSystemObject

接着使用这个引用FileSystemObject对象的变量来处理Drive、Folder、File和TextStream对象。
如何使用FileSystemObject对象来处理文件和文件夹？
一旦创建了FileSystemObject对象的新实例，就能够使用它来处理驱动器、文件夹和文件了。
下面的过程返回特定文件夹中的文件到Dictionary对象里。GetFiles过程接受三个参数：目录路径、Dictionary对象、一个可选的布尔参数，指定是否应该递归调用该过程。该过程返回一个布尔值，指明是否过程运行成功。
该过程首先使用GetFolder方法返回对Folder对象的引用，然后遍历该文件夹的Files集合，添加每个文件的文件名称和路径到Dictionary对象中。如果blnRecursive参数设置为True，那么GetFiles过程被递归调用以返回每个子文件夹中的文件。

Function GetFiles(strPath As String, _ dctDict As Scripting.Dictionary, _ Optional blnRecursive As Boolean) As Boolean   ' 本过程返回目录中的所有文件到Dictionary对象中. ' 如果递归调用则同时返回子文件夹中的所有文件. Dim fsoSysObj As Scripting.FileSystemObject Dim fdrFolder As Scripting.Folder Dim fdrSubFolder As Scripting.Folder Dim filFile As Scripting.File   ' 返回新的FileSystemObject. Set fsoSysObj = New Scripting.FileSystemObject   On Error Resume Next ' 获取文件夹. Set fdrFolder = fsoSysObj.GetFolder(strPath) If Err <> 0 Then ' 不正确的路径. GetFiles = False GoTo GetFiles_End End If On Error GoTo 0   ' 遍历Files集合,添加到字典. For Each filFile In fdrFolder.Files dctDict.Add filFile.Path, filFile.Path Next filFile   ' 如果Recursive标志为真,则递归调用. If blnRecursive Then For Each fdrSubFolder In fdrFolder.SubFolders GetFiles fdrSubFolder.Path, dctDict, True Next fdrSubFolder End If   ' 如果没有错误发生则返回True. GetFiles = True   GetFiles_End: Exit Function End Function   ' 如果没有错误发生则返回True. GetFiles = True   GetFiles_End: Exit Function End Function

可以使用下面的过程来测试GetFiles过程。该过程创建一个新Dictionary对象，将其传递到GetFiles过程，然后在立即窗口中打印在strDirPath目录及其子目录中的每个文件。

Sub TestGetFiles() ' 测试GetFiles函数. Dim dctDict As Scripting.Dictionary Dim varItem As Variant Dim strDirPath As String   strDirPath = "c:\my documents\" ' 创建新的字典. Set dctDict = New Scripting.Dictionary ' 递归调用, 返回文件到Dictionary对象. If GetFiles(strDirPath, dctDict, True) Then ' 打印字典中的项目. For Each varItem In dctDict Debug.Print varItem Next End If End Sub

可以对strDirPath参数试验不同的值，看看该过程是如何工作的。
如何使用FileSystemObject来处理文件属性？
File对象和Folder对象提供了Attributes属性，可用来读取或设置文件或文件夹的属性，如下面的示例。
ChangeFileAttributes过程接受四个参数：文件夹的路径、指定要设置的属性的可选的常量、指定要移除的属性的可选常量、指定是否递归调用过程的可选的参数。
如果传递的文件夹路径是有效的，那么该过程返回Folder对象。接着检查是否提供了lngSetAttr参数，如果是，那么该过程遍历文件夹中的所有文件，追加新的属性到每个文件现有的属性中。对于lngRemoveAttr参数做同样的事情，在本例中，如果指定的属性存在于集合中的文件内则移除。
最后，该过程检查blnRecursive参数是否被设置为True，如果是则为strPath参数指定的每个子文件夹中的每个文件调用该过程。

Function ChangeFileAttributes(strPath As String, _ Optional lngSetAttr As FileAttribute, _ Optional lngRemoveAttr As FileAttribute, _ Optional blnRecursive As Boolean) As Boolean  

' 本函数接受一个目录路径, 一个指定文件属性设置的值

' 一个指定文件属性移除的值

' 一个指明是否递归调用的标志

' 如果没有发生错误则返回True.

Dim fsoSysObj As Scripting.FileSystemObject

Dim fdrFolder As Scripting.Folder

Dim fdrSubFolder As Scripting.Folder

Dim filFile As Scripting.File  

' 返回新的FileSystemObject.

Set fsoSysObj = New Scripting.FileSystemObject  

 On Error Resume Next

' 获取文件夹.

Set fdrFolder = fsoSysObj.GetFolder(strPath)

If Err <> 0 Then ' 不正确的路径.

ChangeFileAttributes = False

 GoTo ChangeFileAttributes_End

 End If On Error GoTo 0   ' 如果调用者传递属性去设置则设置所有的.

If lngSetAttr Then

  For Each filFile In fdrFolder.Files

    If Not (filFile.Attributes And lngSetAttr) Then

       filFile.Attributes = filFile.Attributes Or lngSetAttr

    End If

 Next

End If   ' 如果调用者传递属性去移除则移除所有的.

If lngRemoveAttr Then

  For Each filFile In fdrFolder.Files

        If (filFile.Attributes And lngRemoveAttr) Then

             filFile.Attributes = filFile.Attributes - lngRemoveAttr End If Next End If

       ' 如果调用者设置blnRecursive参数为True,则递归调用函数.

        If blnRecursive Then

       ' 遍历子文件夹.

        For Each fdrSubFolder In fdrFolder.SubFolders

       ' 调用带有子文件夹路径的函数.

       ChangeFileAttributes fdrSubFolder.Path, lngSetAttr, _ lngRemoveAttr, True

       Next

       End If 

      ChangeFileAttributes = True

      ChangeFileAttributes_End: Exit Function

 End Function

可以使用下面的过程测试ChangeFileAttributes过程。在本例中，具有隐藏属性设置的“我的文档”文件夹中的所有文件被设置可见：

Sub TestChangeAttributes() If ChangeFileAttributes("c:\my documents", , _ Hidden, False) = True Then MsgBox "File attributes succesfully changed!" End If End Sub

可以对ChangefileAttributes过程中的参数试验不同的值，看看该过程是如何工作的。
使用FileSearch对象
FileSearch对象是Microsoft Office 9.0 Object Library中的一个成员，公开了Office文件打开对话框的所有功能的编程接口，包括在高级查找对话框中的功能。可以使用FileSearch对象的对象、方法和属性基于提供的条件来搜索文件或文件集合。
下面的示例展示了如何使用FileSearch驿象查找在strFilespec参数中指定类型的一个和多个文件。注意，通过分号分隔符指定扩展名列表可以搜索多个文件扩展名：

Function CustomFindFile(strFileSpec As String)

 ' 本过程演示一个简单的文件搜索程序

' 显示一个消息框,包含在"C:\"目录中与参数strFileSpec提供的文件规范相匹配的所有文件的名称

' 参数strFileSpec可以包含一个或多个在分号分隔列表中的文件规格.

' 例如,下面的strFileSpec参数返回"c:\"中包含扩展名"*.log;*.bat;*.ini"的包有文件

 Dim fsoFileSearch As Office.FileSearch

Dim varFile As Variant Dim strFileList As String  

' 如果输入有效,那么处理文件搜索.

If Len(strFileSpec) >= 3 And InStr(strFileSpec, "*.") > 0 Then

 Set fsoFileSearch = Application.FileSearch 

 With fsoFileSearch .NewSearch .LookIn = "c:\" .Filename = strFileSpec .SearchSubFolders = False If .Execute() > 0 Then

 For Each varFile In .FoundFiles

 strFileList = strFileList & varFile & vbCrLf

 Next varFile

 End If

 End With

 MsgBox strFileList

Else MsgBox strFileSpec & " is not a valid file specification."

 Exit Function

End If

 End Function

FileSearch对象有两个方法和一些属性，可用于在自定义的Office解决方案中创建自定义文件搜索功能。上述示例使用NewSearch方法清除任何以前的搜索条件，Execute方法执行搜索特定的文件。Execute方法返回找到的文件数，同时支持可选的参数来指定排序顺序、排序类型、以及是否用来仅保存快速搜索索引来执行搜索。使用FoundFiles属性返回对FoundFiles对象的引用（FoundFiles对象包含搜索中找到的所有匹配文件的名称）。
使用LookIn属性指定搜索的目录，使用SearchSubFolders属性指定是否搜索在LookIn属性指定的目录中的子文件夹。FileName属性支持通配符和文件名或文件类型规范的分号分隔列表。

注：本文初译自MSDN：Working with Files, Folders, and Drives: More VBA Tips and Tricks，辑录于此，作为文件操作应用大全的一部分。