[發問] 請問如何在"文字方塊"輸入條件後再去搜尋資料

蝕光迴狼

請問要如何寫才能達到我要的效果?

1. 我想要在以下路徑搜尋我要的資料　\\D1502111\暫存區\
　但資料夾有幾千個，故我用了【文字方塊1】與【文字方塊2】【文字方塊3】讓使用者可以自行輸入條件

2.希望可以達到指定路徑：\\D1502111\暫存區\資料夾一(文字方塊內容1)\資料夾二(文字方塊內容2)\

3.按執行後，可以依【搜尋的關鍵字(文字方塊內容3)】去搜尋，
　D槽底下自動建立一個資料夾依【搜尋的關鍵字(文字方塊內容3)】為命名方式，
　並將搜尋到的，全部檔案複製到D槽底下自動創建的資料夾。

麻煩各位高手幫幫我了，謝謝～

蝕光迴狼

回復 16# GBKEE


Dear  GBKEE 版主大大：
　　　可以了謝謝您細心講解，終於按照您的說明完成了，謝謝您～

GBKEE

回復 15# 蝕光迴狼

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim gb As String
   
4.     gb = "D:\關鍵字"  '存檔位置
   
5.     Shell "explorer  " & gb, vbMaximizedFocus
   
6.     '"explorer  "空一格 + (連接上)要開啟的資料夾 或 檔案
   
7.     '參數:vbMaximizedFocus,請參考 Shell 函數的說明
   
8. End Sub

複製代碼

蝕光迴狼

回復 14# GBKEE


Dear GBKEE 版主：

　不知道是不是我的問題．2種都不是我要的效果，

　我要的是程式執行全部跑完後，會跳出 gb = "D:\" & ML3 & "\" '存檔位置

　這一行的資料夾，但一直想不出來怎麼寫？

　勞煩大大您了，謝謝您～

GBKEE

回復 13# 蝕光迴狼
是這樣嗎?

1. '//**********************************//
   
2.     ChDir gb   '改變目前的目錄或檔案夾
   
3.     With Application.FileDialog(msoFileDialogFilePicker)
   
4.         .Show
   
5.     End With
   
6.    '//**********************************//

複製代碼

還是如此

1. '//**********************************//
   
2.     Dim e As Variant
   
3.     ChDir gb   '改變目前的目錄或檔案夾
   
4.     With Application.FileDialog(msoFileDialogFilePicker)
   
5.         If .Show = True Then
   
6.             For Each e In .SelectedItems
   
7.                 Workbooks.Open e
   
8.             Next
   
9.         End If
   
10.     End With
    
11.    '//**********************************//

複製代碼

蝕光迴狼

回復 12# GBKEE


Dear  GBKEE 版主大大：

　打算在以下程式執行完後，自動帶出自創資料夾

　

1. Option Explicit
   
2. '模組上端的 Dim (宣告變數為這模組的私用變數),僅這模組的程序可使用
   
3. Dim gb As String, fsd As Object, ML3 As String
   
4. 
   
5. 
   
6. Private Sub CommandButton1_Click()
   
7. 
   
8. Dim fd As String, dm As String, ML1 As String, ML2 As String
   
9. '程序中的 Dim (宣告變數為這程序的私用變數,僅這程序中可使用)
   
10. 
    
11. dm = "D:\測試用\" '搜尋主路徑
    
12. ML1 = Range("E3") '搜尋檔案資料夾目錄一
    
13. ML2 = Range("E5") '搜尋檔案資料夾目錄二
    
14. ML3 = Range("E7") '搜尋檔案關鍵字
    
15. gb = "D:\" & ML3 & "\" '存檔位置
    
16. 
    
17. Set fsd = CreateObject("Scripting.FileSystemObject")
    
18. fd = dm & ML1 & "\" & ML2 & "\" '檔案資料夾位置
    
19. If fsd.folderexists(gb) = False Then fsd.createfolder gb '自創資料夾不存在則建立
    
20. 副程式 fd
    
21. End Sub
    
22. 
    
23. Private Sub 副程式(資料夾 As String)
    
24. Dim F As Object
    
25. Debug.Print 資料夾 '可看一下 子資料夾名稱
    
26. If Dir(資料夾 & "\*" & ML3 & "*") <> "" Then '測試關鍵字檔名是否存在
    
27. fsd.copyfile 資料夾 & "\*" & ML3 & "*", gb
    
28. End If
    
29. '*** 如資料夾下有子資料夾 再呼叫這副.程式 ***
    
30. '呼叫 程式的迴圈
    
31. For Each F In fsd.GetFolder(資料夾).SUBFolderS
    
32. 副程式 F & ""
    
33. Next
    
34. End Sub

複製代碼

GBKEE

回復 11# 蝕光迴狼


   

但不知道怎麼運用

你要做何事?

蝕光迴狼

回復 9# GBKEE


Dear  GBKEE 版主大大：

　再請問一件事情：最後怎麼自動開啓這個資料夾?

1. gb = "D:\" & ML3 & "\" '存檔位置

複製代碼

   

　爬文後，只知道下面這行程式：
  Shell "explorer D:\測試用\"  '單純打開資料夾
  Workbooks.Open ("D:\測試用\搜尋關鍵字.xls")  '單純打開檔案

　但不知道怎麼運用

蝕光迴狼

回復 9# GBKEE


Dear  GBKEE 版主大大：

　謝謝您費心幫忙，多虧 GBKEE 你 與 Hsieh 大大，鼎力相助，再次謝謝您們了～

GBKEE

回復 8# 蝕光迴狼
   

3. 有個地方不明白，執行後並不會依關鍵字去複製檔案，反而複製資料夾底下全部的檔案。

1. 10.fs = Dir(fd & "*" & ML3 & "*") '測試關鍵字檔名是否存在
   
2. 11.  If fs <> "" Then    '這裡判斷有關鍵字檔名的檔案
   
3. '*** 不會複製資料夾底下全部的檔案 ****

複製代碼

ML3 = Range("E7") '搜尋檔案關鍵字
會是Range("E7")中沒有字串,???造成的嗎?

1. Option Explicit
   
2. '模組上端的 Dim (宣告變數為這模組的私用變數),僅這模組的程序可使用
   
3. Dim gb As String, fsd As Object, ML3 As String
   
4. Private Sub CommandButton1_Click()
   
5. '程序中的 Dim (宣告變數為這程序的私用變數,僅這程序中可使用)
   
6. Dim fd As String, dm As String, ML1 As String, ML2 As String
   
7.     dm = "D:\測試用\" '搜尋主路徑
   
8.     ML1 = Range("E3") '搜尋檔案資料夾目錄一
   
9.     ML2 = Range("E5") '搜尋檔案資料夾目錄二
   
10.     ML3 = Range("E7") '搜尋檔案關鍵字
    
11.     gb = "D:\" & ML3 & "\" '存檔位置
    
12.     Set fsd = CreateObject("Scripting.FileSystemObject")
    
13.     fd = dm & ML1 & "\" & ML2 & "\" '檔案資料夾位置
    
14.     If fsd.folderexists(gb) = False Then fsd.createfolder gb '自創資料夾不存在則建立
    
15.     副程式 fd
    
16. End Sub
    
17. Private Sub 副程式(資料夾 As String)
    
18.     Dim F As Object
    
19.     Debug.Print 資料夾  '可看一下 子資料夾名稱
    
20.     If Dir(資料夾 & "\*" & ML3 & "*") <> "" Then '測試關鍵字檔名是否存在
    
21.         fsd.copyfile 資料夾 & "\*" & ML3 & "*", gb
    
22.     End If
    
23.     '*** 如資料夾下有子資料夾 再呼叫這副.程式 ***
    
24.     '呼叫 程式的迴圈
    
25.     For Each F In fsd.GetFolder(資料夾).SUBFolderS
    
26.         副程式 F & ""
    
27.     Next
    
28. End Sub

複製代碼