****************移动文件夹************************

1、添加引用"microsoft    scripting    runtime"

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'拷贝文件夹

End sub

***************新建文件夹**************************

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

然后再作回归调用就可

注意：以上代码在遍历文件时不能对文件作保存，不然会陷入无限循环！

复制文件测试代码：

Private Sub Command1_Click()

Dim FileSys As New FileSystemObject

Dim FolderObj As Folder

Set FileSys = CreateObject("scripting.filesystemobject")

If Dir("d:/mz.txt", vbNormal) = "" Then

Dim mz As String

If Text1.Text <> "" Then

mz = Trim(Text1.Text)

FileSys.CopyFile "c:/ss.txt", "d:/mz.txt", True         '拷贝c盘文件ss到d盘并改名为mm

Else

MsgBox "你必须输入一个名字"

End If

Else

MsgBox "D盘文件名存在，请改名！"

Exit Sub

End If

'If Dir("D:\2", vbDirectory) = "" Then

'FileSys.CopyFolder "c:/1", "d:/2", True         '拷贝文件夹

'Else

'MsgBox "D盘文件名存在，请改名！"

'Exit Sub

'End If

End Sub