Re: [VB6 ] 關於複製資料夾的問題
需要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
推
02/16 03:26, , 1F
02/16 03:26, 1F
討論串 (同標題文章)