九色国产,午夜在线视频,新黄色网址,九九色综合,天天做夜夜做久久做狠狠,天天躁夜夜躁狠狠躁2021a,久久不卡一区二区三区

***************新建文件夾************************** 

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會(huì)產(chǎn)生錯(cuò)誤！

If fso.FileExists(fileName) = False Then
     sWenJJ_MingC = "000001"
Else
    sWenJJ_MingC = "000002"
End If

改為以上代碼判斷文件是否存在即可解決問題。

另外，若dir使用很多修改不便的話可換另一方法，

先新建一個(gè)文件夾mkdir()，

再將原文件夾里面的東西全考到新文件夾即可。下面的SHFileOperation方法采用*.*參數(shù)即可實(shí)現(xiàn)。

***********************************另附參考代碼*********************************

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   
 

上邊的是判斷文件夾  
  這個(gè)是判斷文件          
  fileName   =   folds   &   "/name.txt"                             ‘文件名  
          bln1   =   fso1.FileExists(fileName   )  
          If   Not   bln1   Then       ‘不存在   就創(chuàng)建一個(gè)  
                  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的復(fù)制文件夾得方法？

用API函數(shù) SHFileOperation
以下是使用SHFileOperation刪除復(fù)制移動(dòng)文件的例子，可以復(fù)制文件夾

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 時(shí)用
End Type

Private Declare Function SHFileOperation Lib _
"shell32.dll" Alias "SHFileOperationA" (lpFileOp _
As SHFILEOPSTRUCT) As Long

'wFunc 常數(shù)
'FO_COPY　 把 pFrom 文件拷貝到 pTo。
Const FO_COPY = &H2
'FO_DELETE 刪除 pFrom 中的文件（pTo 忽略）。
Const FO_DELETE = &H3
'FO_MOVE　 把 pFrom 文件移動(dòng)到 pTo。
Const FO_MOVE = &H1

'fFlag 常數(shù)
'FOF_ALLOWUNDO 允許 Undo 。
Const FOF_ALLOWUNDO = &H40
'FOF_NOCONFIRMATION 不顯示系統(tǒng)確認(rèn)對(duì)話框。
Const FOF_NOCONFIRMATION = &H10
'FOF_NOCONFIRMMKDIR 不提示是否新建目錄。
Const FOF_NOCONFIRMMKDIR = &H200
'FOF_SILENT 不顯示進(jìn)度對(duì)話框
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)
' 刪除多個(gè)文件
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)
' 移動(dòng)
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遍歷文件夾**************************

經(jīng)測(cè)試，遍歷文件有效，子文件夾好象有點(diǎn)問題

用文件系統(tǒng)對(duì)象，先創(chuàng)建該對(duì)象的文件夾對(duì)象，
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

然后再作回歸調(diào)用就可

注意：以上代碼在遍歷文件時(shí)不能對(duì)文件作保存，不然會(huì)陷入無限循環(huán)！

復(fù)制文件測(cè)試代碼：

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 "你必須輸入一個(gè)名字"

  End If

  Else

  MsgBox "D盤文件名存在，請(qǐng)改名！"

Exit Sub

End If

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

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

'Else

 'MsgBox "D盤文件名存在，請(qǐng)改名！"

'Exit Sub

'End If

End Sub