社区 › VBA/VB/ActiveX/API 编程技术 › 分享源代码：文件对象模块

vbcad 发表于 2018-12-6 19:50:42

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

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

Public Function FolderExists(FolderPath As String) As Boolean
'检查目录是否存在
Dim fso As Object
Set fso = CreateObject("Scripting.filesystemobject")
FolderExists = fso.FolderExists(FolderPath)
Set fso = Nothing
End Function
Public Function FileExists(FilePath As String) As Boolean
'检查文件是否存在
Dim fso As Object
Set fso = CreateObject("Scripting.filesystemobject")
FileExists = fso.FileExists(FilePath)
Set fso = Nothing
End Function

Public Function GetDriveName(FilePath As String) As String
'从路径中提取驱动器名（FilePath=“C:\WINDOWS\Test.TXT”，返回 C:）
Dim fso As Object
Set fso = CreateObject("Scripting.filesystemobject")
GetDriveName = fso.GetDriveName(FilePath)
Set fso = Nothing
End Function
Public Function GetFolderName(FilePath As String) As String
'从路径中提取目录名（FilePath=“C:\WINDOWS\Test.TXT”，返回 C:\WINDOWS）
Dim fso As Object
Set fso = CreateObject("Scripting.filesystemobject")
GetFolderName = fso.GetParentFolderName(FilePath)
Set fso = Nothing
End Function
Public Function GetFileName(FilePath As String) As String
'从路径中提取文件名（FilePath=“C:\WINDOWS\Test.TXT”，返回 Test.TXT）
Dim fso As Object
Set fso = CreateObject("Scripting.filesystemobject")
GetFileName = fso.GetFileName(FilePath)
Set fso = Nothing
End Function
Public Function GetExtensionName(FilePath As String) As String
'从路径中提取文件扩展名（FilePath=“C:\WINDOWS\Test.TXT”，返回 TXT）
Dim fso As Object
Set fso = CreateObject("Scripting.filesystemobject")
GetExtensionName = fso.GetExtensionName(FilePath)
Set fso = Nothing
End Function

Public Function GetBaseName(FilePath As String) As String
'从路径中提取文件名(不带路径与扩展名)（FilePath=“C:\WINDOWS\Test.TXT”，返回 Test）
Dim fso As Object
Set fso = CreateObject("Scripting.filesystemobject")
GetBaseName = fso.GetBaseName(FilePath)
Set fso = Nothing
End Function

Public Function GetFileLastDate(FilePath As String) As Date
'返回文件最后修改日期（FilePath=“C:\WINDOWS\Test.TXT”，返回时间如： 2000-1-1 22:22:22）
Dim fso As Object
Dim objFile As Object
Set fso = CreateObject("Scripting.filesystemobject")
Set objFile = fso.GetFile(FilePath)
GetFileLastDate = objFile.DateLastModified
Set fso = Nothing
End Function
Public Function GetFileSize(FilePath As String) As String
'返回文件大小（FilePath=“C:\WINDOWS\Test.TXT”，返回如： 1kb）
Dim fso As Object
Dim objFile As Object
Set fso = CreateObject("Scripting.filesystemobject")
Set objFile = fso.GetFile(FilePath)
GetFileSize = FormatNumber(objFile.Size / 1024, 0) & "KB"
Set fso = Nothing
End Function
Public Function GetShortName(FilePath As String) As String
'从路径中提取8.3短文件名（FilePath=“C:\WINDOWS\Test.TXT”，返回 Test.TXT）
Dim fso As Object
Dim objFile As Object
Set fso = CreateObject("Scripting.filesystemobject")
Set objFile = fso.GetFile(FilePath)
GetShortName = objFile.ShortName
Set fso = Nothing
End Function
Public Function GetShortPath(FilePath As String) As String
'从路径中提取8.3短文件路径（FilePath=“C:\WINDOWS\Test.TXT”，返回 C:\WINDOWS\Test.TXT）
Dim fso As Object
Dim objFile As Object
Set fso = CreateObject("Scripting.filesystemobject")
Set objFile = fso.GetFile(FilePath)
GetShortPath = objFile.ShortPath
Set fso = Nothing
End Function

Public Function GetFileList(Folder As String) As String()
'列出目录中文件,以数组形式返回目录下文件（不含子目录），下标为0
Dim fso As Object
Dim objFolder As Object
Dim objFile As Object
Dim arrTmp() As String
Dim i As Long
Set fso = CreateObject("Scripting.filesystemobject")
Set objFolder = fso.GetFolder(Folder) '获得目录中的所有对象

ReDim arrTmp(objFolder.Files.Count)
For Each objFile In objFolder.Files                     '遍历文件夹下的文件
    arrTmp(i) = objFile.Path
    i = i + 1
Next
GetFileList = arrTmp
Set fso = Nothing
End Function



Public Function GetDriveFreeSpace(FilePath As String) As String
Dim fso As Object
Dim Drive As Object
Set fso = CreateObject("Scripting.filesystemobject")
Set Drive = fso.GetDrive(GetDriveName(FilePath))
GetDriveFreeSpace = FormatNumber(Drive.FreeSpace / 1024 / 1024 / 1024, 0) & "GB"
Set fso = Nothing
End Function

Public Function GetDriveTotalSize(FilePath As String) As String
Dim fso As Object
Dim Drive As Object
Set fso = CreateObject("Scripting.filesystemobject")
Set Drive = fso.GetDrive(GetDriveName(FilePath))
GetDriveTotalSize = FormatNumber(Drive.TotalSize / 1024 / 1024 / 1024, 0) & "GB"
Set fso = Nothing
End Function

Public Function GetDriveSerialNumber(FilePath As String) As String
Dim fso As Object
Dim Drive As Object
Set fso = CreateObject("Scripting.filesystemobject")
Set Drive = fso.GetDrive(GetDriveName(FilePath))
GetDriveSerialNumber = Drive.SerialNumber
Set fso = Nothing
End Function
Public Function GetDriveList() As String()
'获得系统所有盘符
Dim fso As Object
Dim objDrive As Object
Dim arrTmp() As String
Dim i As Long
Set fso = CreateObject("Scripting.filesystemobject")
ReDim arrTmp(fso.Drives.Count)
For Each objDrive In fso.Drives                     '遍历
'    Debug.Print objDrive.DriveLetter, objDrive.DriveType
    arrTmp(i) = objDrive.DriveLetter
    i = i + 1
Next
GetDriveList = arrTmp
Set fso = Nothing
End Function

BaoWSE 发表于 2018-12-7 12:34:57

谢谢楼主分享经验！

mycad 发表于 2019-1-22 15:03:33

yzys 发表于 2019-4-24 08:27:15

感谢楼主分享

查看完整版本: 分享源代码：文件对象模块