ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: ykcbf

[求助]FSO是什么?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2012-8-10 21:11 | 显示全部楼层
好东西,又学到新的东西了

TA的精华主题

TA的得分主题

发表于 2012-8-10 21:41 来自手机 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
全面丰富的介绍,虽然不太懂,但也能增长知识面

TA的精华主题

TA的得分主题

发表于 2013-4-6 21:53 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
学习了,谢谢

TA的精华主题

TA的得分主题

发表于 2013-10-28 20:16 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2013-10-28 21:29 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
楼主你就不能重新排下版面么?看得眼疼。

TA的精华主题

TA的得分主题

发表于 2013-10-28 21:43 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
VB 编程中经常需要和文件系统打交道,比如获取硬盘的剩余空间、判断文件夹或文件是否存在等。

在VB 推出文件系统对象(File System Object)以前,完成这些功能需要调用 Windows API 函数或者使用一些比较复杂的过程来实现,使编程复杂、可靠性差又容易出错。

使用 Windows 提供的的文件系统对象,一切变得简单多了。

以下笔者举出一些编程中比较常用的例子,以函数或过程的形式提供给大家,读者可在编程中直接使用,也可以改进后实现更为强大的功能。

要应用 FSO 对象,须要引用一个名为 Scripting 的类型库,方法是:
执行 VB6.0 的菜单项“工程/引用”,添加引用列表框中的“Microsoft Scripting Runtime”一项。
然后我们在“对象浏览器”中就可以看到 Scripting 类型库下的众多对象及其方法、属性。

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

张庆 Email:zhangking at 263.net QQ: 9365822 http://www.why100000.com

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2013-10-28 22:22 | 显示全部楼层
上述代码复制到模块中去了……

FSO CODE Example.rar

10.01 KB, 下载次数: 32

TA的精华主题

TA的得分主题

发表于 2013-10-28 22:29 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2013-11-22 17:14 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
Rowen 发表于 2004-7-26 17:38
我找到一个比较好的说明:认识 VB 的文件系统对象 FSO    zhangking(原作) [ 作者:zhangking    转贴自: ...

解释得太好了

TA的精华主题

TA的得分主题

发表于 2014-7-5 09:40 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
老帖重新整理。新人有福了
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-12-22 18:39 , Processed in 0.042253 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表