乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 109|回复: 2

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

[复制链接]

13

主题

59

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
111
发表于 2018-12-6 19:50:00 | 显示全部楼层 |阅读模式
FileSystemObject 对象的作用:提供对计算机文件系统的访问,它允许我们在代码内操作文本文件、文件夹及驱动器。FileSystemObject 对象提供一个属性和一系列方法,可用它们来操纵 FileSystemObject 对象实现的一些从属对象。我把常用功能写成了模块,供大家使用,代码如下:
  1. Public Function FolderExists(FolderPath As String) As Boolean
  2. '检查目录是否存在
  3. Dim fso As Object
  4. Set fso = CreateObject("Scripting.filesystemobject")
  5. FolderExists = fso.FolderExists(FolderPath)
  6. Set fso = Nothing
  7. End Function
  8. Public Function FileExists(FilePath As String) As Boolean
  9. '检查文件是否存在
  10. Dim fso As Object
  11. Set fso = CreateObject("Scripting.filesystemobject")
  12. FileExists = fso.FileExists(FilePath)
  13. Set fso = Nothing
  14. End Function
  15. Public Function GetDriveName(FilePath As String) As String
  16. '从路径中提取驱动器名(FilePath=“C:\WINDOWS\Test.TXT”,返回 C:)
  17. Dim fso As Object
  18. Set fso = CreateObject("Scripting.filesystemobject")
  19. GetDriveName = fso.GetDriveName(FilePath)
  20. Set fso = Nothing
  21. End Function
  22. Public Function GetFolderName(FilePath As String) As String
  23. '从路径中提取目录名(FilePath=“C:\WINDOWS\Test.TXT”,返回 C:\WINDOWS)
  24. Dim fso As Object
  25. Set fso = CreateObject("Scripting.filesystemobject")
  26. GetFolderName = fso.GetParentFolderName(FilePath)
  27. Set fso = Nothing
  28. End Function
  29. Public Function GetFileName(FilePath As String) As String
  30. '从路径中提取文件名(FilePath=“C:\WINDOWS\Test.TXT”,返回 Test.TXT)
  31. Dim fso As Object
  32. Set fso = CreateObject("Scripting.filesystemobject")
  33. GetFileName = fso.GetFileName(FilePath)
  34. Set fso = Nothing
  35. End Function
  36. Public Function GetExtensionName(FilePath As String) As String
  37. '从路径中提取文件扩展名(FilePath=“C:\WINDOWS\Test.TXT”,返回 TXT)
  38. Dim fso As Object
  39. Set fso = CreateObject("Scripting.filesystemobject")
  40. GetExtensionName = fso.GetExtensionName(FilePath)
  41. Set fso = Nothing
  42. End Function
  43. Public Function GetBaseName(FilePath As String) As String
  44. '从路径中提取文件名(不带路径与扩展名)(FilePath=“C:\WINDOWS\Test.TXT”,返回 Test)
  45. Dim fso As Object
  46. Set fso = CreateObject("Scripting.filesystemobject")
  47. GetBaseName = fso.GetBaseName(FilePath)
  48. Set fso = Nothing
  49. End Function
  50. Public Function GetFileLastDate(FilePath As String) As Date
  51. '返回文件最后修改日期(FilePath=“C:\WINDOWS\Test.TXT”,返回时间如: 2000-1-1 22:22:22)
  52. Dim fso As Object
  53. Dim objFile As Object
  54. Set fso = CreateObject("Scripting.filesystemobject")
  55. Set objFile = fso.GetFile(FilePath)
  56. GetFileLastDate = objFile.DateLastModified
  57. Set fso = Nothing
  58. End Function
  59. Public Function GetFileSize(FilePath As String) As String
  60. '返回文件大小(FilePath=“C:\WINDOWS\Test.TXT”,返回如: 1kb)
  61. Dim fso As Object
  62. Dim objFile As Object
  63. Set fso = CreateObject("Scripting.filesystemobject")
  64. Set objFile = fso.GetFile(FilePath)
  65. GetFileSize = FormatNumber(objFile.Size / 1024, 0) & "KB"
  66. Set fso = Nothing
  67. End Function
  68. Public Function GetShortName(FilePath As String) As String
  69. '从路径中提取8.3短文件名(FilePath=“C:\WINDOWS\Test.TXT”,返回 Test.TXT)
  70. Dim fso As Object
  71. Dim objFile As Object
  72. Set fso = CreateObject("Scripting.filesystemobject")
  73. Set objFile = fso.GetFile(FilePath)
  74. GetShortName = objFile.ShortName
  75. Set fso = Nothing
  76. End Function
  77. Public Function GetShortPath(FilePath As String) As String
  78. '从路径中提取8.3短文件路径(FilePath=“C:\WINDOWS\Test.TXT”,返回 C:\WINDOWS\Test.TXT)
  79. Dim fso As Object
  80. Dim objFile As Object
  81. Set fso = CreateObject("Scripting.filesystemobject")
  82. Set objFile = fso.GetFile(FilePath)
  83. GetShortPath = objFile.ShortPath
  84. Set fso = Nothing
  85. End Function
  86. Public Function GetFileList(Folder As String) As String()
  87. '列出目录中文件,以数组形式返回目录下文件(不含子目录),下标为0
  88. Dim fso As Object
  89. Dim objFolder As Object
  90. Dim objFile As Object
  91. Dim arrTmp() As String
  92. Dim i As Long
  93. Set fso = CreateObject("Scripting.filesystemobject")
  94. Set objFolder = fso.GetFolder(Folder) '获得目录中的所有对象
  95. ReDim arrTmp(objFolder.Files.Count)
  96. For Each objFile In objFolder.Files                     '遍历文件夹下的文件
  97.     arrTmp(i) = objFile.Path
  98.     i = i + 1
  99. Next
  100. GetFileList = arrTmp
  101. Set fso = Nothing
  102. End FunctionPublic Function GetDriveFreeSpace(FilePath As String) As String
  103. Dim fso As Object
  104. Dim Drive As Object
  105. Set fso = CreateObject("Scripting.filesystemobject")
  106. Set Drive = fso.GetDrive(GetDriveName(FilePath))
  107. GetDriveFreeSpace = FormatNumber(Drive.FreeSpace / 1024 / 1024 / 1024, 0) & "GB"
  108. Set fso = Nothing
  109. End Function
  110. Public Function GetDriveTotalSize(FilePath As String) As String
  111. Dim fso As Object
  112. Dim Drive As Object
  113. Set fso = CreateObject("Scripting.filesystemobject")
  114. Set Drive = fso.GetDrive(GetDriveName(FilePath))
  115. GetDriveTotalSize = FormatNumber(Drive.TotalSize / 1024 / 1024 / 1024, 0) & "GB"
  116. Set fso = Nothing
  117. End Function
  118. Public Function GetDriveSerialNumber(FilePath As String) As String
  119. Dim fso As Object
  120. Dim Drive As Object
  121. Set fso = CreateObject("Scripting.filesystemobject")
  122. Set Drive = fso.GetDrive(GetDriveName(FilePath))
  123. GetDriveSerialNumber = Drive.SerialNumber
  124. Set fso = Nothing
  125. End Function
  126. Public Function GetDriveList() As String()
  127. '获得系统所有盘符
  128. Dim fso As Object
  129. Dim objDrive As Object
  130. Dim arrTmp() As String
  131. Dim i As Long
  132. Set fso = CreateObject("Scripting.filesystemobject")
  133. ReDim arrTmp(fso.Drives.Count)
  134. For Each objDrive In fso.Drives                     '遍历
  135. '    Debug.Print objDrive.DriveLetter, objDrive.DriveType
  136.     arrTmp(i) = objDrive.DriveLetter
  137.     i = i + 1
  138. Next
  139. GetDriveList = arrTmp
  140. Set fso = Nothing
  141. End Function
回复

使用道具 举报

0

主题

35

帖子

10

银币

初来乍到

Rank: 1

铜币
35
发表于 2018-12-7 12:34:00 | 显示全部楼层
谢谢楼主分享经验!
回复

使用道具 举报

0

主题

4

帖子

2

银币

初来乍到

Rank: 1

铜币
4
发表于 2019-4-24 08:27:00 | 显示全部楼层
感谢楼主分享
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2024-11-22 00:10 , Processed in 0.136840 second(s), 58 queries .

© 2020-2024 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表