注册 登录
Office中国论坛/Access中国论坛 返回首页

todaynew的个人空间 http://www.office-cn.net/?144436 [收藏] [复制] [分享] [RSS]

日志

FSO,驱动器、文件

已有 864 次阅读2009-2-14 15:28 |个人分类:资料|

  1、判断光驱的盘符:
   Function GetCDROM() ´ 返回光驱的盘符(字母)
   Dim Fso As New FileSystemObject ´创建 FSO 对象的一个实例
   Dim FsoDrive As Drive, FsoDrives As Drives ´定义驱动器、驱动器集合对象
   Set FsoDrives = Fso.Drives
   For Each FsoDrive In FsoDrives ´遍历所有可用的驱动器
   If FsoDrive.DriveType = CDRom Then ´如果驱动器的类型为 CDrom
    GetCDROM = FsoDrive.DriveLetter ´输出其盘符
   Else
    GetCDROM = \"\"
   End If
   Next
   Set Fso = Nothing
   Set FsoDrive = Nothing
   Set FsoDrives = Nothing
   End Function
  2、判断文件、文件夹是否存在:
   ´返回布尔值:True 存在,False 不存在,filername 文件名
   Function FileExist(filename As String)
   Dim Fso As New FileSystemObject
   If Fso.FileExists(filename) = True Then
   FileExist = True
   Else
   FileExist = False
   End If
   Set Fso = Nothing
   End Function
   ´返回布尔值:True 存在,False 不存在,foldername 文件夹
   Function FolderExist(foldername As String)
   Dim Fso As New FileSystemObject
   If Fso.FolderExists(foldername) = True Then
   FolderExist = True
   Else
   FolderExist = False
   End If
   Set Fso = Nothing
   End Function
  3、获取驱动器参数:
   ´返回磁盘总空间大小(单位:M),Drive = 盘符 A ,C, D ...
   Function AllSpace(Drive As String)
   Dim Fso As New FileSystemObject, Drv As Drive
   Set Drv = Fso.GetDrive(Drive) ´得到 Drv 对象的实例
   If Drv.IsReady Then ´如果该驱动器存在(软驱或光驱里有盘片,硬盘存取正常)
   AllSpace = Format(Drv.TotalSize / (2 ^ 20), \"0.00\") ´将字节转换为兆
   Else
   AllSpace = 0
   End If
   Set Fso = Nothing
   Set Drv = Nothing
   End Function
   ´返回磁盘可用空间大小(单位:M),Drive = 盘符 A ,C, D ...
   Function FreeSpace(drive)
   Dim Fso As New FileSystemObject, drv As drive
   Set drv = Fso.GetDrive(drive)
   If drv.IsReady Then
   FreeSpace = Format(drv.FreeSpace / (2 ^ 20), \"0.00\")
   End If
   Set Fso = Nothing
   Set Drv = Nothing
   End Function
   ´获取驱动器文件系统类型,Drive = 盘符 A ,C, D ...
   Function FsType(Drive As String)
   Dim Fso As New FileSystemObject, Drv As Drive
   Set Drv = Fso.GetDrive(Drive)
   If Drv.IsReady Then
   FsType = Drv.FileSystem
   Else
   FsType = \"\"
   End If
   Set Fso = Nothing
   Set Drv = Nothing
   End Function
  4,获取系统文件夹路径:
   ´返回 Windows 文件夹路径
   Function GetWindir()
   Dim Fso As New FileSystemObject
   GetWindir = Fso.GetSpecialFolder(WindowsFolder)
   Set Fso = Nothing
   End Function
   ´返回 Windows\\System 文件夹路径
   Function GetWinSysdir()
   Dim Fso As New FileSystemObject
   GetWinSysdir = Fso.GetSpecialFolder(SystemFolder)
   Set Fso = Nothing
   End Function
  5,综合运用:一个文件备份通用过程:
   ´Filename = 文件名,Drive = 驱动器,Folder = 文件夹(一层)
   Sub BackupFile(Filename As String, Drive As String, Folder As String)
   Dim Fso As New FileSystemObject ´创建 FSO 对象实例
   Dim Dest_path As String, Counter As Long
   Counter = 0
   Do While Counter < 6 ´如果驱动器没准备好,继续检测。共检测 6 秒
   Counter = Counter + 1
   Call Waitfor(1) ´间隔 1 秒
   If Fso.Drives(Drive).IsReady = True Then
   Exit Do
   End If
   Loop
   If Fso.Drives(Drive).IsReady = False Then ´6 秒后目标盘仍未准备就绪,退出
   MsgBox \" 目标驱动器 \" & Drive & \" 没有准备好! \", vbCritical
   Exit Sub
   End If
   If Fso.GetDrive(Drive).FreeSpace < Fso.GetFile(Filename).Size Then
   MsgBox \"目标驱动器空间太小!\", vbCritical ´目标驱动器空间不够,退出
   Exit Sub
   End If
   If Right(Drive, 1) <> \":\" Then
   Drive = Drive & \":\"
   End If
   If Left(Folder, 1) <> \"\\\" Then
   Folder = \"\\\" & Folder
   End If
   If Right(Folder, 1) <> \"\\\" Then
   Folder = Folder & \"\\\"
   End If
   Dest_path = Drive & Folder
   If Not Fso.FolderExists(Dest_path) Then ´如果目标文件夹不存在,创建之
   Fso.CreateFolder Dest_path
   End If
   Fso.CopyFile Filename, Dest_path & Fso.GetFileName(Filename), True
   ´拷贝,直接覆盖同名文件
   MsgBox \" 文件备份完毕。\", vbOKOnly
   Set Fso = Nothing
   End Sub
   Private Sub Waitfor(Delay As Single) ´延时过程,Delay 单位约为 1 秒
   Dim StartTime As Single
   StartTime = Timer
   Do Until (Timer - StartTime) > Delay
   Loop
   End Sub

评论 (0 个评论)

facelist doodle 涂鸦板

您需要登录后才可以评论 登录 | 注册

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-13 14:11 , Processed in 0.182761 second(s), 17 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

返回顶部