分享源代码：文件对象模块

vbcad

       FileSystemObject 对象的作用：提供对计算机文件系统的访问，它允许我们在代码内操作文本文件、文件夹及驱动器。FileSystemObject 对象提供一个属性和一系列方法，可用它们来操纵 FileSystemObject 对象实现的一些从属对象。我把常用功能写成了模块，供大家使用，代码如下：

2. 
   
3. Public Function FolderExists(FolderPath As String) As Boolean
   
4. '检查目录是否存在
   
5. Dim fso As Object
   
6. Set fso = CreateObject("Scripting.filesystemobject")
   
7. FolderExists = fso.FolderExists(FolderPath)
   
8. Set fso = Nothing
   
9. End Function
   
10. Public Function FileExists(FilePath As String) As Boolean
    
11. '检查文件是否存在
    
12. Dim fso As Object
    
13. Set fso = CreateObject("Scripting.filesystemobject")
    
14. FileExists = fso.FileExists(FilePath)
    
15. Set fso = Nothing
    
16. End Function
    
17. 
    
18. Public Function GetDriveName(FilePath As String) As String
    
19. '从路径中提取驱动器名（FilePath=“C:\WINDOWS\Test.TXT”，返回 C:）
    
20. Dim fso As Object
    
21. Set fso = CreateObject("Scripting.filesystemobject")
    
22. GetDriveName = fso.GetDriveName(FilePath)
    
23. Set fso = Nothing
    
24. End Function
    
25. Public Function GetFolderName(FilePath As String) As String
    
26. '从路径中提取目录名（FilePath=“C:\WINDOWS\Test.TXT”，返回 C:\WINDOWS）
    
27. Dim fso As Object
    
28. Set fso = CreateObject("Scripting.filesystemobject")
    
29. GetFolderName = fso.GetParentFolderName(FilePath)
    
30. Set fso = Nothing
    
31. End Function
    
32. Public Function GetFileName(FilePath As String) As String
    
33. '从路径中提取文件名（FilePath=“C:\WINDOWS\Test.TXT”，返回 Test.TXT）
    
34. Dim fso As Object
    
35. Set fso = CreateObject("Scripting.filesystemobject")
    
36. GetFileName = fso.GetFileName(FilePath)
    
37. Set fso = Nothing
    
38. End Function
    
39. Public Function GetExtensionName(FilePath As String) As String
    
40. '从路径中提取文件扩展名（FilePath=“C:\WINDOWS\Test.TXT”，返回 TXT）
    
41. Dim fso As Object
    
42. Set fso = CreateObject("Scripting.filesystemobject")
    
43. GetExtensionName = fso.GetExtensionName(FilePath)
    
44. Set fso = Nothing
    
45. End Function
    
46. 
    
47. Public Function GetBaseName(FilePath As String) As String
    
48. '从路径中提取文件名(不带路径与扩展名)（FilePath=“C:\WINDOWS\Test.TXT”，返回 Test）
    
49. Dim fso As Object
    
50. Set fso = CreateObject("Scripting.filesystemobject")
    
51. GetBaseName = fso.GetBaseName(FilePath)
    
52. Set fso = Nothing
    
53. End Function
    
54. 
    
55. Public Function GetFileLastDate(FilePath As String) As Date
    
56. '返回文件最后修改日期（FilePath=“C:\WINDOWS\Test.TXT”，返回时间如： 2000-1-1 22:22:22）
    
57. Dim fso As Object
    
58. Dim objFile As Object
    
59. Set fso = CreateObject("Scripting.filesystemobject")
    
60. Set objFile = fso.GetFile(FilePath)
    
61. GetFileLastDate = objFile.DateLastModified
    
62. Set fso = Nothing
    
63. End Function
    
64. Public Function GetFileSize(FilePath As String) As String
    
65. '返回文件大小（FilePath=“C:\WINDOWS\Test.TXT”，返回如： 1kb）
    
66. Dim fso As Object
    
67. Dim objFile As Object
    
68. Set fso = CreateObject("Scripting.filesystemobject")
    
69. Set objFile = fso.GetFile(FilePath)
    
70. GetFileSize = FormatNumber(objFile.Size / 1024, 0) & "KB"
    
71. Set fso = Nothing
    
72. End Function
    
73. Public Function GetShortName(FilePath As String) As String
    
74. '从路径中提取8.3短文件名（FilePath=“C:\WINDOWS\Test.TXT”，返回 Test.TXT）
    
75. Dim fso As Object
    
76. Dim objFile As Object
    
77. Set fso = CreateObject("Scripting.filesystemobject")
    
78. Set objFile = fso.GetFile(FilePath)
    
79. GetShortName = objFile.ShortName
    
80. Set fso = Nothing
    
81. End Function
    
82. Public Function GetShortPath(FilePath As String) As String
    
83. '从路径中提取8.3短文件路径（FilePath=“C:\WINDOWS\Test.TXT”，返回 C:\WINDOWS\Test.TXT）
    
84. Dim fso As Object
    
85. Dim objFile As Object
    
86. Set fso = CreateObject("Scripting.filesystemobject")
    
87. Set objFile = fso.GetFile(FilePath)
    
88. GetShortPath = objFile.ShortPath
    
89. Set fso = Nothing
    
90. End Function
    
91. 
    
92. Public Function GetFileList(Folder As String) As String()
    
93. '列出目录中文件,以数组形式返回目录下文件（不含子目录），下标为0
    
94. Dim fso As Object
    
95. Dim objFolder As Object
    
96. Dim objFile As Object
    
97. Dim arrTmp() As String
    
98. Dim i As Long
    
99. Set fso = CreateObject("Scripting.filesystemobject")
    
100. Set objFolder = fso.GetFolder(Folder) '获得目录中的所有对象
     
101. 
     
102. ReDim arrTmp(objFolder.Files.Count)
     
103. For Each objFile In objFolder.Files                     '遍历文件夹下的文件
     
104.     arrTmp(i) = objFile.Path
     
105.     i = i + 1
     
106. Next
     
107. GetFileList = arrTmp
     
108. Set fso = Nothing
     
109. End Function
     
110. 
     
111. 
     
112. 
     
113. Public Function GetDriveFreeSpace(FilePath As String) As String
     
114. Dim fso As Object
     
115. Dim Drive As Object
     
116. Set fso = CreateObject("Scripting.filesystemobject")
     
117. Set Drive = fso.GetDrive(GetDriveName(FilePath))
     
118. GetDriveFreeSpace = FormatNumber(Drive.FreeSpace / 1024 / 1024 / 1024, 0) & "GB"
     
119. Set fso = Nothing
     
120. End Function
     
121. 
     
122. Public Function GetDriveTotalSize(FilePath As String) As String
     
123. Dim fso As Object
     
124. Dim Drive As Object
     
125. Set fso = CreateObject("Scripting.filesystemobject")
     
126. Set Drive = fso.GetDrive(GetDriveName(FilePath))
     
127. GetDriveTotalSize = FormatNumber(Drive.TotalSize / 1024 / 1024 / 1024, 0) & "GB"
     
128. Set fso = Nothing
     
129. End Function
     
130. 
     
131. Public Function GetDriveSerialNumber(FilePath As String) As String
     
132. Dim fso As Object
     
133. Dim Drive As Object
     
134. Set fso = CreateObject("Scripting.filesystemobject")
     
135. Set Drive = fso.GetDrive(GetDriveName(FilePath))
     
136. GetDriveSerialNumber = Drive.SerialNumber
     
137. Set fso = Nothing
     
138. End Function
     
139. Public Function GetDriveList() As String()
     
140. '获得系统所有盘符
     
141. Dim fso As Object
     
142. Dim objDrive As Object
     
143. Dim arrTmp() As String
     
144. Dim i As Long
     
145. Set fso = CreateObject("Scripting.filesystemobject")
     
146. ReDim arrTmp(fso.Drives.Count)
     
147. For Each objDrive In fso.Drives                     '遍历
     
148. '    Debug.Print objDrive.DriveLetter, objDrive.DriveType
     
149.     arrTmp(i) = objDrive.DriveLetter
     
150.     i = i + 1
     
151. Next
     
152. GetDriveList = arrTmp
     
153. Set fso = Nothing
     
154. End Function

<br /> Public Function FolderExists(FolderPath As String) As Boolean<br /> '检查目录是否存在<br /> Dim fso As Object<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> FolderExists = fso.FolderExists(FolderPath)<br /> Set fso = Nothing<br /> End Function<br /> Public Function FileExists(FilePath As String) As Boolean<br /> '检查文件是否存在<br /> Dim fso As Object<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> FileExists = fso.FileExists(FilePath)<br /> Set fso = Nothing<br /> End Function<br /> <br /> Public Function GetDriveName(FilePath As String) As String<br /> '从路径中提取驱动器名（FilePath=“C:\WINDOWS\Test.TXT”，返回 C:）<br /> Dim fso As Object<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> GetDriveName = fso.GetDriveName(FilePath)<br /> Set fso = Nothing<br /> End Function<br /> Public Function GetFolderName(FilePath As String) As String<br /> '从路径中提取目录名（FilePath=“C:\WINDOWS\Test.TXT”，返回 C:\WINDOWS）<br /> Dim fso As Object<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> GetFolderName = fso.GetParentFolderName(FilePath)<br /> Set fso = Nothing<br /> End Function<br /> Public Function GetFileName(FilePath As String) As String<br /> '从路径中提取文件名（FilePath=“C:\WINDOWS\Test.TXT”，返回 Test.TXT）<br /> Dim fso As Object<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> GetFileName = fso.GetFileName(FilePath)<br /> Set fso = Nothing<br /> End Function<br /> Public Function GetExtensionName(FilePath As String) As String<br /> '从路径中提取文件扩展名（FilePath=“C:\WINDOWS\Test.TXT”，返回 TXT）<br /> Dim fso As Object<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> GetExtensionName = fso.GetExtensionName(FilePath)<br /> Set fso = Nothing<br /> End Function<br /> <br /> Public Function GetBaseName(FilePath As String) As String<br /> '从路径中提取文件名(不带路径与扩展名)（FilePath=“C:\WINDOWS\Test.TXT”，返回 Test）<br /> Dim fso As Object<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> GetBaseName = fso.GetBaseName(FilePath)<br /> Set fso = Nothing<br /> End Function<br /> <br /> Public Function GetFileLastDate(FilePath As String) As Date<br /> '返回文件最后修改日期（FilePath=“C:\WINDOWS\Test.TXT”，返回时间如： 2000-1-1 22:22:22）<br /> Dim fso As Object<br /> Dim objFile As Object<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> Set objFile = fso.GetFile(FilePath)<br /> GetFileLastDate = objFile.DateLastModified<br /> Set fso = Nothing<br /> End Function<br /> Public Function GetFileSize(FilePath As String) As String<br /> '返回文件大小（FilePath=“C:\WINDOWS\Test.TXT”，返回如： 1kb）<br /> Dim fso As Object<br /> Dim objFile As Object<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> Set objFile = fso.GetFile(FilePath)<br /> GetFileSize = FormatNumber(objFile.Size / 1024, 0) & "KB"<br /> Set fso = Nothing<br /> End Function<br /> Public Function GetShortName(FilePath As String) As String<br /> '从路径中提取8.3短文件名（FilePath=“C:\WINDOWS\Test.TXT”，返回 Test.TXT）<br /> Dim fso As Object<br /> Dim objFile As Object<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> Set objFile = fso.GetFile(FilePath)<br /> GetShortName = objFile.ShortName<br /> Set fso = Nothing<br /> End Function<br /> Public Function GetShortPath(FilePath As String) As String<br /> '从路径中提取8.3短文件路径（FilePath=“C:\WINDOWS\Test.TXT”，返回 C:\WINDOWS\Test.TXT）<br /> Dim fso As Object<br /> Dim objFile As Object<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> Set objFile = fso.GetFile(FilePath)<br /> GetShortPath = objFile.ShortPath<br /> Set fso = Nothing<br /> End Function<br /> <br /> Public Function GetFileList(Folder As String) As String()<br /> '列出目录中文件,以数组形式返回目录下文件（不含子目录），下标为0<br /> Dim fso As Object<br /> Dim objFolder As Object<br /> Dim objFile As Object<br /> Dim arrTmp() As String<br /> Dim i As Long<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> Set objFolder = fso.GetFolder(Folder) '获得目录中的所有对象<br /> <br /> ReDim arrTmp(objFolder.Files.Count)<br /> For Each objFile In objFolder.Files                     '遍历文件夹下的文件<br />     arrTmp(i) = objFile.Path<br />     i = i + 1<br /> Next<br /> GetFileList = arrTmp<br /> Set fso = Nothing<br /> End Function<br /> <br /> <br /> <br /> Public Function GetDriveFreeSpace(FilePath As String) As String<br /> Dim fso As Object<br /> Dim Drive As Object<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> Set Drive = fso.GetDrive(GetDriveName(FilePath))<br /> GetDriveFreeSpace = FormatNumber(Drive.FreeSpace / 1024 / 1024 / 1024, 0) & "GB"<br /> Set fso = Nothing<br /> End Function<br /> <br /> Public Function GetDriveTotalSize(FilePath As String) As String<br /> Dim fso As Object<br /> Dim Drive As Object<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> Set Drive = fso.GetDrive(GetDriveName(FilePath))<br /> GetDriveTotalSize = FormatNumber(Drive.TotalSize / 1024 / 1024 / 1024, 0) & "GB"<br /> Set fso = Nothing<br /> End Function<br /> <br /> Public Function GetDriveSerialNumber(FilePath As String) As String<br /> Dim fso As Object<br /> Dim Drive As Object<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> Set Drive = fso.GetDrive(GetDriveName(FilePath))<br /> GetDriveSerialNumber = Drive.SerialNumber<br /> Set fso = Nothing<br /> End Function<br /> Public Function GetDriveList() As String()<br /> '获得系统所有盘符<br /> Dim fso As Object<br /> Dim objDrive As Object<br /> Dim arrTmp() As String<br /> Dim i As Long<br /> Set fso = CreateObject("Scripting.filesystemobject")<br /> ReDim arrTmp(fso.Drives.Count)<br /> For Each objDrive In fso.Drives                     '遍历<br /> '    Debug.Print objDrive.DriveLetter, objDrive.DriveType<br />     arrTmp(i) = objDrive.DriveLetter<br />     i = i + 1<br /> Next<br /> GetDriveList = arrTmp<br /> Set fso = Nothing<br /> End Function

BaoWSE

谢谢楼主分享经验！

mycad

yzys

感谢楼主分享