乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 23|回复: 0

经本人测试通过的一些FSO移植到VBA

[复制链接]

31

主题

227

帖子

8

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
351
发表于 2012-1-19 11:29:00 | 显示全部楼层 |阅读模式
'查询磁盘信息
Private Sub CommandButton1_Click()
Dim fsoTest As Object
Dim drv1 As Object  'N年前乐筑天下老大的专贴中写成了drive,这里提醒一下呵呵
Dim sReturn As String
Set fsoTest = CreateObject("Scripting.FileSystemObject")
Set drv1 = fsoTest.GetDrive("K:\")
sReturn = "Drive " & "K:\" & vbCrLf
sReturn = sReturn & "VolumeName" & drv1.VolumeName & vbCrLf
sReturn = sReturn & "Total Space: " & FormatNumber(drv1.TotalSize / 1024, 0)
sReturn = sReturn & "Kb" & vbCrLf
sReturn = sReturn & "Free Space: " & FormatNumber(drv1.FreeSpace / 1024, 0)
sReturn = sReturn & "Kb" & vbCrLf
sReturn = sReturn & "FileSystem:" & drv1.FileSystem & vbCrLf
MsgBox sReturn
End Sub
'显示保存框
Private Sub CommandButton10_Click()
Dim b As Object
Dim a As String
Set b = commondialog1.showsave
a = richtextbox1.savefile(commondialog1.FileName.trfRTF)
End Sub
'新建文本文件
Private Sub CommandButton12_Click()
Dim a As Object
Dim b As Object
Dim c As String
Set a = CreateObject("Scripting.FileSystemObject")
Set b = a.createtextfile("k:\tt.txt", True)
b.writeline ("my first love")
MsgBox "creat new text!"
b.Close
End Sub
'得到文件时间
Private Sub CommandButton15_Click()
Dim a As Object
Dim b As Object
Dim c As String
Set a = CreateObject("Scripting.FileSystemObject")
Set b = a.getfile("k:\web.txt")
c = b & " " & b.datecreated
MsgBox c
End Sub
'新建文件夹
Private Sub CommandButton2_Click()
Dim a As Object
Dim b As Object
Set a = CreateObject("Scripting.FileSystemObject")
Set b = a.createfolder("k:\new folder")
End Sub
'删除文件或文件夹
Private Sub CommandButton3_Click()
Dim a, b As Object
Set a = CreateObject("Scripting.FileSystemObject")
'Set b = a.getfolder("k:\新建文件夹 (2)")
Set b = a.deletefolder("k:\新建文件夹 (2)")
End Sub
'显示文件夹建立时间
Private Sub CommandButton4_Click()
Dim a As Object
Dim b As Object, c As String
Set a = CreateObject("Scripting.FileSystemObject")
Set b = a.getfolder("k:\工作文章")
c = b.datecreated
MsgBox b & " " & c
End Sub
'移动文件 实际木起作用待大伙改进
Private Sub CommandButton5_Click()
Dim a As Object
Dim b As Object
Set a = CreateObject("Scripting.FileSystemObject")
Set b = a.movefile("k:\batch  plot  dwg.lsp", "k:\txt\batch  plot  dwg.lsp")
End Sub
'复制文件
Private Sub CommandButton6_Click()
Dim a As Object
Dim b As Object
Set a = CreateObject("Scripting.FileSystemObject")
Set b = a.Copyfile("k:\*.txt", "K:\txt\")
End Sub
'复制文件或文件夹
Private Sub CommandButton7_Click()
Dim a As Object
Dim b As Object
Dim c As Object
Set a = CreateObject("Scripting.FileSystemObject")
Set b = a.getfile("k:\txt.lsp")
Set c = b.Copy("k:\中桥\", True)
End Sub
'移动文件夹  实际木起作用待大伙改进
Private Sub CommandButton9_Click()
Dim a As Object
Dim b As Object
Set a = CreateObject("Scripting.FileSystemObject")
Set b = a.movefolder("k:\箱梁文件", "k:\中桥")
End Sub
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-6-30 10:14 , Processed in 0.847730 second(s), 54 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表