应用程序 VBA/文件和文件夹实用程序
- 第一组实用程序集中在基本FileSystemObject集合上；也就是说，用于查找文件或文件夹是否存在、大小以及是否具有特定属性的集合。还提供了基本的路径解析过程。所有这些过程都需要在 VBA 编辑器中引用Microsoft Scripting Runtime。
- 没有发现普遍有用的代码来测试打开的文件。虽然存在许多过程，但它们在某种程度上都失败了，通常无法识别打开的文本或图像文件，或者标记为只读的 Office 文件。问题的根源是，Windows 中的许多此类文件在用户打开时不会锁定，因此尝试通过尝试获得唯一访问权限来检测打开状态的过程无法做到这一点。任何拥有通用解决方案的读者都可以随时发表评论。
有时需要知道文件或文件夹是否具有特定属性，例如，为了避免隐藏或系统文件出现在列表中。过程HasAttribute执行此操作，将文件路径作为参数以及一个简短代码来标识感兴趣的属性。但是，属性包随所有属性编号值相加一起提供，因此此类测试，就像涉及常量的其他枚举（例如；消息框类型）一样，利用AND函数来拆分包。
例如：（参见下面的 HasAttribute 过程。）假设从 GetAttr 获得的属性包等于 37
并且我们只测试“系统”属性（“S”）与 vbSystem = 4。现在，对于数字，
AND 运算符对每列执行按位 AND 运算，因此给出
01001012 = 3710 = vbArchive + vbSystem + vbReadOnly
00001002 = 410 = vbSystem
_______
00001002 = 410，布尔变量解释为 True，因为它不为零
也就是说，“系统”属性存在于属性包中。
如果“系统”属性未设置，则结果将全部为零。
重要的是要注意，返回值只测试一次一个属性；也就是说，虽然文件对于只读（“R”）返回true，但它也可能具有未测试的其他属性。如果用户希望在一个字符串中返回所有文件或文件夹属性，则可以做一些工作来连接结果代码。
ParsePath 过程中给出了文件路径解析的示例。该示例使用Split函数将所有反斜杠分隔的项放入数组中，然后重新组合它们以创建路径。类似的方法，以点进行拆分，用于创建文件名和后缀。
Option Explicit
Function FileFound(sPath As String) As Boolean
'returns true if parameter path file found
Dim fs As FileSystemObject
'set ref to fso
Set fs = CreateObject("Scripting.FileSystemObject")
'test for file
FileFound = fs.FileExists(sPath)
Set fs = Nothing
End Function
Function FolderFound(sPath As String) As Boolean
'returns true if parameter path folder found
Dim fs As FileSystemObject
'set ref to fso
Set fs = CreateObject("Scripting.FileSystemObject")
'test for folder
FolderFound = fs.FolderExists(sPath)
Set fs = Nothing
End Function
Function GetFileSize(sPath As String, nSize As Long) As Boolean
'returns file size in bytes for parameter path file
Dim fs As FileSystemObject, f As File
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(sPath) Then
Set f = fs.GetFile(sPath)
nSize = f.Size
GetFileSize = True
End If
Set fs = Nothing: Set f = Nothing
End Function
Function GetFolderSize(sPath As String, nSize As Long) As Boolean
'returns total content size in bytes for parameter path folder
Dim fs As FileSystemObject, f As Folder
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FolderExists(sPath) Then
Set f = fs.GetFolder(sPath)
nSize = f.Size
GetFolderSize = True
End If
Set fs = Nothing: Set f = Nothing
End Function
Function HasAttribute(sPath As String, sA As String) As Boolean
'returns true if parameter path file or folder INCLUDES test parameter
'eg: if sA= "H" then returns true if file attributes INCLUDE "hidden"
'Untested attributes might also exist
'sA values
'"R"; read only, "H"; hidden, "S"; system, "A"; archive
'"D"; directory, "X"; alias, "N"; normal
Dim bF As Boolean, nA As Integer
Dim bFile As Boolean, bFldr As Boolean
Dim fs As FileSystemObject, f As File, fd As Folder
Set fs = CreateObject("Scripting.FileSystemObject")
'check path parameter
bFile = fs.FileExists(sPath)
bFldr = fs.FolderExists(sPath)
If bFile Or bFldr Then
'get its attribute bundle
nA = GetAttr(sPath)
Else
'neither found so exit
MsgBox "Bad path parameter"
GoTo Wayout
End If
'early exit for no attributes
If nA = 0 And sA = "N" Then '0
HasAttribute = True
Exit Function
End If
'test for attribute in sA
'logical AND on number variable bit columns
If (nA And vbReadOnly) And sA = "R" Then '1
bF = True
ElseIf (nA And vbHidden) And sA = "H" Then '2
bF = True
ElseIf (nA And vbSystem) And sA = "S" Then '4
bF = True
ElseIf (nA And vbDirectory) And sA = "D" Then '16
bF = True
ElseIf (nA And vbArchive) And sA = "A" Then '32
bF = True
ElseIf (nA And vbAlias) And sA = "X" Then '64
bF = True
End If
HasAttribute = bF
Wayout:
Set fs = Nothing: Set f = Nothing: Set fd = Nothing
End Function
Function ParsePath(sPath As String, Optional sP As String, _
Optional sF As String, Optional sS As String) As Boolean
'sPath has full file path
'returns path of file with end backslash (sP),
'file name less suffix (sF), and suffix less dot(sS)
Dim vP As Variant, vS As Variant, n As Long
Dim bF As Boolean, fs As FileSystemObject
'set ref to fso
Set fs = CreateObject("Scripting.FileSystemObject")
'test that file exists
bF = fs.FileExists(sPath)
If Not bF Then
'MsgBox "File not found"
GoTo Wayout
End If
'make array from path elements split on backslash
vP = Split(sPath, "\")
'make array from file name elements split on dot
vS = Split(vP(UBound(vP)), ".")
'rebuild path with backslashes
For n = LBound(vP) To UBound(vP) - 1
sP = sP & vP(n) & "\"
Next n
sF = vS(LBound(vS))
sS = vS(UBound(vS))
ParsePath = True
Wayout:
Set fs = Nothing
End Function