天天看点

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

然后再作回归调用就可

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

上一篇: en_e out1
下一篇: 疑难en_a

继续阅读