作者fysky (枫)
看板Visual_Basic
标题Re: [VB6 ] 关於复制资料夹的问题
时间Sat Feb 16 01:04:24 2008
需要2个TextBox物件 分别命名为Text1及Text2
以及1个CommandButton物件 命名为Command1
程式码如下：
Option Explicit
Dim sDirectoryList() As String '纪录子目录
Dim nDirectory As Long '纪录子目录数量
Dim sFileList() As String '纪录档案
Dim nFile As Long '纪录档案数量
Private Sub Command1_Click()
Dim strPath As String
Dim i As Long
nDirectory = 0
nFile = 0
strPath = Text1.Text & IIf(Right(Text1.Text, 1) = "\", "", "\")
'寻找strPath目录下所有子目录及所有档案
listFile (strPath)
i = 1
Do While (i <= nDirectory)
listFile (sDirectoryList(i))
i = i + 1
DoEvents
Loop
'制作所有子目录
i = 1
Do While (i <= nDirectory)
MkDirs Replace(sDirectoryList(i), Text1.Text, Text2.Text)
i = i + 1
DoEvents
Loop
'复制所有档案
i = 1
Do While (i <= nFile)
FileCopy sFileList(i), Replace(sFileList(i), Text1.Text, Text2.Text)
i = i + 1
DoEvents
Loop
End Sub
'列出目录下档案及子资料夹
Private Sub listFile(Path As String)
Dim MyDirFile As String
MyDirFile = Dir(Path, vbDirectory)
Do While MyDirFile <> ""
If MyDirFile <> "." And MyDirFile <> ".." Then
If (GetAttr(Path & MyDirFile) And vbDirectory) Then
nDirectory = nDirectory + 1
ReDim Preserve sDirectoryList(nDirectory)
sDirectoryList(nDirectory) = Path & MyDirFile & "\"
Else
nFile = nFile + 1
ReDim Preserve sFileList(nFile)
sFileList(nFile) = Path & MyDirFile
End If
End If
MyDirFile = Dir
Loop
End Sub
'制作巢状目录
Public Sub MkDirs(Path As String)
Dim nPos As Long
Path = Path & IIf(Right(Path, 1) = "\", "", "\")
nPos = InStr(1, Path, "\")
Do While nPos > 0
If Dir(Left(Path, nPos), vbDirectory) = "" Then
MkDir Left(Path, nPos)
End If
nPos = InStr(nPos + 1, Path, "\")
Loop
Exit Sub
End Sub
--
※ 发信站: 批踢踢实业坊(ptt.cc)
◆ From: 61.223.36.156
1F：推 bestgood:感谢大大，我试试看 02/16 03:26