经本人测试通过的一些FSO移植到VBA
本帖最后由 crazylsp 于 2012-1-19 11:37 编辑'查询磁盘信息
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:\batchplotdwg.lsp", "k:\txt\batchplotdwg.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
页:
[1]