46、Scripting.FileSystemObject对象的学习,用代码操作文本文件、文件夹及驱动器。这里有一份详细的帮助,建议打印出来仔细阅读http://www.officefans.net/cdb/vi ... d=45704&fpage=3
aurora兄也做了一个很好的例子,“列出某文件夹下所有子文件夹之路径及大小
”http://www.officefans.net/cdb/vi ... d=43019&fpage=2
我也是在学习他们资料的时候大致做了一个简单例子,希望能给初学者一点帮助。
KOqWv9ze.rar
(12.89 KB, 下载次数: 172)
,代码:
Const S$ = "E:\HUJINSONG" '定义一个常量,新增的文件夹的路径及名称
Sub Add_folder() '新增文件夹及子文件夹、工作簿等,运行之后在E盘看看结果
Dim fs As Scripting.FileSystemObject
Dim fl As Scripting.File
Dim wb As Workbook
Dim s1$
Set fs = CreateObject("Scripting.filesystemobject")
If fs.FolderExists(S) Then MsgBox "文件已存在哦,请确认": Exit Sub
fs.CreateFolder S '增加一个文件夹,E盘的hujinsong
For i = 1 To 10
fs.CreateFolder S & "\" & Format(i, "000") '增加10个子文件夹001到010
Next
s1 = S & "\001\" & "新工作簿.xls" '一个新增的工作簿的名称及路径
Set wb = Workbooks.Add
With wb
.Sheets(1).[a1].Value = "试验工作簿"
.SaveAs Filename:=s1
.Close
End With '在第一个文件夹里增加一个新工作簿
Set fl = fs.GetFile(s1) '得到这个新增工作簿对象,赋值为fl
With fl
.Copy S & "\002\" '复制到第二个文件夹里
.Copy S & "\005\" '复制到第5个文件夹里
.Copy S & "\005\hjsong.xls" '直接在copy时,也更改它的名字
End With
End Sub
Sub Show_All() '显示文件夹的属性、内容、大小等,如果文件夹的大小为0则删除
Dim fs As Scripting.FileSystemObject
Dim f As Scripting.Folder
Dim f1 As Scripting.Folder
Set fs = New Scripting.FileSystemObject '另外一种方式
If Not fs.FolderExists(S) Then MsgBox "文件不存在哦,请确认": Exit Sub
Set f = fs.GetFolder(S) '得到s文件夹对象
For Each f1 In f.SubFolders '在子文件夹里做一个循环
Debug.Print f1, f1.Size, f1.Attributes 'f1为子文件夹的全部路径,size表示它的大小,在VBE中按Ctrl+G查看结果
If f1.Size = 0 Then f1.Delete '假如子文件夹大小为0,则删除
Next
Set fs = Nothing
End Sub
Sub Del_folder() '删除文件夹
Dim fs As Scripting.FileSystemObject
Set fs = New Scripting.FileSystemObject
On Error Resume Next '防止删除的文件夹不存在,产生错误
fs.DeleteFolder S '删除新建的文件夹
End Sub
【注】对于Dim fs As Scripting.FileSystemObject,需要引用“Miscosoft scripting runtime”,例子中借用大师的作品在打开时自动引用,如果不引用的话,就不能这样定义,只能在程序做好之后,把上面的定义都修改为Dim fs As,大家可以试试。 |