作者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