2、使用方法
Option Explicit
Private Sub Form_Load()
Dim FileSys As New FileSystemObject
Dim FolderObj As Folder
Set FileSys = CreateObject("scripting.filesystemobject")
FileSys.CopyFile "c:/ss.txt", "d:/mm.txt", True'拷贝文件
FileSys.CopyFolder "c:/1", "d:/2", True'拷贝文件夹
***************新建文件夹**************************
Dim fso As New FileSystemObject, fdr As Folder,fdrPath as String
fdrPath="C:/newfolder"
fdr = fso.CreateFolder(fdrPath)
***************重命名文件夹***************
Dim aa As New Scripting.FileSystemObject
aa.MoveFolder "c:/1", "c:/2"
**************************************************
fileName = "c:/dzh/export/1001A1AA.XLS"
If Dir(fileName) = "" Then '文件存在
sWenJJ_MingC = "000001"
Else
sWenJJ_MingC = "000002"
End If
pathName = "c:/dzh/dataFX/" & sWenJJ_MingC
fso.MoveFolder "c:/dzh/export", pathName '文件夹剪切,重命名
fso.CreateFolder "c:/dzh/export" '新建文件夹
使用Dir后再使用fso.MoveFolder会产生错误!
If fso.FileExists(fileName) = False Then
sWenJJ_MingC = "000001"
Else
sWenJJ_MingC = "000002"
End If
改为以上代码判断文件是否存在即可解决问题。
另外,若dir使用很多修改不便的话可换另一方法,
先新建一个文件夹mkdir(),
再将原文件夹里面的东西全考到新文件夹即可。下面的SHFileOperation方法采用*.*参数即可实现。
***********************************另附参考代码*********************************
Dim fldr1 As Folder
Dim fldr2 As TextStream
Dim fso1 As
New
FileSystemObject
Dim bln1 As Boolean
Dim folds As String
Dim filestr As String
Dim str_r
folds = App.path & "/Fee" ’
文件夹
Set fso1 = CreateObject("Scripting.FileSystemObject")
bln1 = fso1.FolderExists(folds)
If Not bln1 Then
Set fldr1 = fso1.CreateFolder(App.path & "/Fee") 如果不存在就建立
End If
上边的是判断文件夹
这个是判断文件
fileName = folds & "/name.txt" ‘文件名
bln1 = fso1.FileExists(fileName )
If Not bln1 Then ‘不存在 就创建一个
Set fldr2 = fso1.CreateTextFile(fileName , True)
fldr2.WriteLine str_r
fldr2.Close
Else
Set fldr2 = fso1.OpenTextFile(fileName , ForAppending, TristateFalse)
fldr2.WriteLine str_r
fldr2.Close
End If
****************************另一种非FSO方法*****************************
不用FSO的复制文件夹得方法?
用API函数 SHFileOperation
以下是使用SHFileOperation删除复制移动文件的例子,可以复制文件夹
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String '只有在 FOF_SIMPLEPROGRESS 时用
End Type
Private Declare Function SHFileOperation Lib _
"shell32.dll" Alias "SHFileOperationA" (lpFileOp _
As SHFILEOPSTRUCT) As Long
'wFunc 常数
'FO_COPY 把 pFrom 文件拷贝到 pTo。
Const FO_COPY = &H2
'FO_DELETE 删除 pFrom 中的文件(pTo 忽略)。
Const FO_DELETE = &H3
'FO_MOVE 把 pFrom 文件移动到 pTo。
Const FO_MOVE = &H1
'fFlag 常数
'FOF_ALLOWUNDO 允许 Undo 。
Const FOF_ALLOWUNDO = &H40
'FOF_NOCONFIRMATION 不显示系统确认对话框。
Const FOF_NOCONFIRMATION = &H10
'FOF_NOCONFIRMMKDIR 不提示是否新建目录。
Const FOF_NOCONFIRMMKDIR = &H200
'FOF_SILENT 不显示进度对话框
Const FOF_SILENT = &H4
'例子:
Dim SHFileOp As SHFILEOPSTRUCT
' 删除
SHFileOp.wFunc = FO_DELETE
SHFileOp.pFrom = "c:/config.old" + Chr(0)
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
Call SHFileOperation(SHFileOp)
' 删除多个文件
SHFileOp.wFunc = FO_DELETE
SHFileOp.pFrom = "c:/config.old" +Chr(0) + "c:/autoexec.old"+Chr(0)
SHFileOp.fFlags = FOF_ALLOWUNDO
Call SHFileOperation(SHFileOp)
' 拷贝
SHFileOp.wFunc = FO_COPY
SHFileOp.pFrom = "c:/t"
SHFileOp.pTo = "d:/"
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR
Call SHFileOperation(SHFileOp)
' 移动
SHFileOp.wFunc = FO_MOVE
SHFileOp.pFrom = "c:/config.old" + Chr(0)
SHFileOp.pTo = "d:/t"
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
Call SHFileOperation(SHFileOp)
***************vb 使用FSO遍历文件夹**************************
经测试,遍历文件有效,子文件夹好象有点问题
用文件系统对象,先创建该对象的文件夹对象,
Option Explicit
Dim ofso As FileSystemObject
Dim fo As Folder
Dim f As File
Dim InFo As Folder
Set ofso = New FileSystemObject
Set fo = ofso.GetFolder("asdfal;sdfj")
For Each f In fo.Files
List1.AddItem f.Name
Next
For Each InFo In fo.SubFolders
List1.AddItem fo.Name
Next
然后再作回归调用就可
注意:以上代码在遍历文件时不能对文件作保存,不然会陷入无限循环!