13
59
2
初露锋芒
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 FunctionPublic 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