- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 8# 蝕光迴狼
3. 有個地方不明白，執行後並不會依關鍵字去複製檔案，反而複製資料夾底下全部的檔案。 - 10.fs = Dir(fd & "*" & ML3 & "*") '測試關鍵字檔名是否存在
- 11. If fs <> "" Then '這裡判斷有關鍵字檔名的檔案
- '*** 不會複製資料夾底下全部的檔案 ****
會是Range("E7")中沒有字串,???造成的嗎?- Option Explicit
- '模組上端的 Dim (宣告變數為這模組的私用變數),僅這模組的程序可使用
- Dim gb As String, fsd As Object, ML3 As String
- Private Sub CommandButton1_Click()
- '程序中的 Dim (宣告變數為這程序的私用變數,僅這程序中可使用)
- Dim fd As String, dm As String, ML1 As String, ML2 As String
- dm = "D:\測試用\" '搜尋主路徑
- ML1 = Range("E3") '搜尋檔案資料夾目錄一
- ML2 = Range("E5") '搜尋檔案資料夾目錄二
- ML3 = Range("E7") '搜尋檔案關鍵字
- gb = "D:\" & ML3 & "\" '存檔位置
- Set fsd = CreateObject("Scripting.FileSystemObject")
- fd = dm & ML1 & "\" & ML2 & "\" '檔案資料夾位置
- If fsd.folderexists(gb) = False Then fsd.createfolder gb '自創資料夾不存在則建立
- 副程式 fd
- End Sub
- Private Sub 副程式(資料夾 As String)
- Dim F As Object
- Debug.Print 資料夾 '可看一下 子資料夾名稱
- If Dir(資料夾 & "\*" & ML3 & "*") <> "" Then '測試關鍵字檔名是否存在
- fsd.copyfile 資料夾 & "\*" & ML3 & "*", gb
- End If
- '*** 如資料夾下有子資料夾 再呼叫這副.程式 ***
- '呼叫 程式的迴圈
- For Each F In fsd.GetFolder(資料夾).SUBFolderS
- 副程式 F & ""
- Next
- End Sub
|
|
發表於 2014-10-2 10:28
| 