VB操作文件夹的几个方法

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

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