12
返回列表 上一主題 發帖

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

蝕光迴狼
　暱稱: 蝕光迴狼

中學生Rank: 2

帖子
75 
主題
6 
精華
0 
積分
83 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
臺灣 
註冊時間
2014-9-22 
最後登錄
2015-3-7 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2014-9-30 01:21 | 只看該作者

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

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

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

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

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

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

各式工作流程.rar (12.58 KB)

收藏 分享
我很笨,所以我很用心
　我學藝不精,但我渴求知識

蝕光迴狼
　暱稱: 蝕光迴狼

中學生Rank: 2

帖子
75 
主題
6 
精華
0 
積分
83 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
臺灣 
註冊時間
2014-9-22 
最後登錄
2015-3-7 

論壇榮譽勳章論壇贊助勳章
2#
發表於 2014-10-1 13:16 | 只看該作者
有沒有高手幫幫我,拜託,因為VBA我不是很熟,
我都是看別人的程式在土法煉鋼......
我很笨,所以我很用心
　我學藝不精,但我渴求知識

TOP

蝕光迴狼
　暱稱: 蝕光迴狼

中學生Rank: 2

帖子
75 
主題
6 
精華
0 
積分
83 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
臺灣 
註冊時間
2014-9-22 
最後登錄
2015-3-7 

論壇榮譽勳章論壇贊助勳章
3#
發表於 2014-10-1 14:28 | 只看該作者
麻煩各位幫幫忙了，如果Excel程式，無法達到我想要的效果，
也請好心告訴我一下，程式辦不到，讓我早點死心放棄．．．．．
謝謝各位熱心的高手大大，十分感謝，百分感謝，千分感謝，萬分感謝，千萬分感謝，
我也是看到此網站，有很多熱心且不求回報的高手大大在，
並想要讓此網站永續經營，也用行動表示我的誠意，
不要讓我的求助文，沉淪拜託∼
我很笨,所以我很用心
　我學藝不精,但我渴求知識

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
88  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-4-16 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 2014-10-1 16:18 | 只看該作者
回復 3# 蝕光迴狼
試試看
  1. Private Sub CommandButton1_Click()
  2. Set fsd = CreateObject("Scripting.FileSystemObject")
  3. fd = "\\D1502111\暫存區\" & TextBox1 & "\" & TextBox2 & "\" '檔案資料夾位置
  4. fs = Dir(fd & "*" & TextBox3 & "*") '測試關鍵字檔名是否存在
  5. If fs <> "" Then
  6.    If fsd.folderexists("D:\自創資料夾") = False Then fsd.createfolder "D:\自創資料夾" '自創資料夾不存在則建立
  7.    fsd.copyfile fd & "*" & TextBox3 & "*", "D:\自創資料夾" '複製檔案
  8. Else
  9.    Exit Sub
  10. End If
  11. End Sub
複製代碼
學海無涯_不恥下問

TOP

蝕光迴狼
　暱稱: 蝕光迴狼

中學生Rank: 2

帖子
75 
主題
6 
精華
0 
積分
83 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
臺灣 
註冊時間
2014-9-22 
最後登錄
2015-3-7 

論壇榮譽勳章論壇贊助勳章
5#
發表於 2014-10-1 17:57 | 只看該作者
回復 4# Hsieh


Dear Hsieh：

　　　真的由衷感謝你的幫助，這幫了我很大的忙，

　　　因為我沒有任何的基礎，所以剛起步對我這初學者來說很辛苦，

　　　我會努力的，到時還請各位高手與　Hsieh　大大多多費心了，謝謝∼
我很笨,所以我很用心
　我學藝不精,但我渴求知識

TOP

蝕光迴狼
　暱稱: 蝕光迴狼

中學生Rank: 2

帖子
75 
主題
6 
精華
0 
積分
83 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
臺灣 
註冊時間
2014-9-22 
最後登錄
2015-3-7 

論壇榮譽勳章論壇贊助勳章
6#
發表於 2014-10-1 19:21 | 只看該作者
回復 4# Hsieh


Dear Hsieh 版主：

　再請問如果連子資料夾，底下的檔案也要全部尋找複製，

　要加入什麼指令? 加在哪一行 ?

　謝謝
我很笨,所以我很用心
　我學藝不精,但我渴求知識

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2014-10-2 10:28 | 只看該作者
回復 6# 蝕光迴狼
對話框 試試看
  1. Sub Ex()
  2.     With Application.FileDialog(msoFileDialogFolderPicker) '開啟資料夾的對話框
  3.         If .Show = True Then
  4.          If MsgBox(.SelectedItems(1) & "  中搜尋 *" & TextBox3, vbYesNo) = vbYes Then
  5.             If Dir("D:\自創資料夾", vbDirectory) = "" Then MkDir ("D:\自創資料夾") '自創資料夾不存在則建立
  6.             TextBox1 = .SelectedItems(1)
  7.             副程式 .SelectedItems(1)
  8.          End If
  9.        End If
  10.     End With
  11. End Sub
  12. Private Sub 副程式(資料夾 As String)
  13.     Dim Fs As Object, F As Object
  14.     Set Fs = CreateObject("Scripting.FileSystemObject")
  15.     If Dir(資料夾 & "\*" & TextBox3 & "*") <> "" Then '測試關鍵字檔名是否存在
  16.         Fs.copyfile 資料夾 & "\*" & TextBox3 & "*", "D:\自創資料夾"
  17.     End If
  18.    
  19.     '*** 如資料夾下有子資料夾 再呼叫這副.程式 ***
  20.     '呼叫 程式的迴圈
  21.     For Each F In Fs.GetFolder(資料夾).SUBFolderS
  22.         Debug.Print F  '可看一下 子資料夾名稱
  23.         副程式 F & ""
  24.     Next
  25. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

蝕光迴狼
　暱稱: 蝕光迴狼

中學生Rank: 2

帖子
75 
主題
6 
精華
0 
積分
83 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
臺灣 
註冊時間
2014-9-22 
最後登錄
2015-3-7 

論壇榮譽勳章論壇贊助勳章
8#
發表於 2014-10-2 16:20 | 只看該作者
本帖最後由 蝕光迴狼 於 2014-10-2 16:22 編輯

回復 7# GBKEE


Dear  GBKEE 版主您好：

　　　非常感謝你繁忙之間抽空幫忙。

　　　1. 您寫的程式，可以抓到子資料夾底下的檔案。

　　　2. 程式迴圈的方式是我最弱的項目，所以看不太懂，不容易我從中學習。

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

　附件中的檔案是我用 Hsieh 版主大人，幫我寫的程式去做修改的，
　
　目前的瓶頸是不知道，要怎麼改程式才能 搜尋與複製　子資料夾底下的檔案？

　●會這樣寫是為了日後方便做維護與修改程式碼。再次謝謝 GBKEE 版主大大


  2. Private Sub CommandButton1_Click()
  3. DM = "D:\測試用\" '搜尋主路徑
  4. ML1 = Range("E3") '搜尋檔案資料夾目錄一
  5. ML2 = Range("E5") '搜尋檔案資料夾目錄二
  6. ML3 = Range("E7") '搜尋檔案關鍵字
  7. gb = "D:\" & ML3 & "\" '存檔位置
  8. Set fsd = CreateObject("Scripting.FileSystemObject")
  9. fd = DM & ML1 & "\" & ML2 & "\" '檔案資料夾位置
  10. fs = Dir(fd & "*" & ML3 & "*") '測試關鍵字檔名是否存在
  11.   If fs <> "" Then
  12.      If fsd.folderexists(gb) = False Then fsd.createfolder gb '自創資料夾不存在則建立
  13.      fsd.copyfile fd & "*" & ML3 & "*", gb '複製檔案
  14.   Else
  15.      Exit Sub  '結束程式
  16.   End If
  17. End Sub
複製代碼

樣本.rar (10.92 KB)

測試用.rar (10.16 KB)

我很笨,所以我很用心
　我學藝不精,但我渴求知識

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 2014-10-2 20:31 | 只看該作者
回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

蝕光迴狼
　暱稱: 蝕光迴狼

中學生Rank: 2

帖子
75 
主題
6 
精華
0 
積分
83 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
臺灣 
註冊時間
2014-9-22 
最後登錄
2015-3-7 

論壇榮譽勳章論壇贊助勳章
10#
發表於 2014-10-2 21:37 | 只看該作者
回復 9# GBKEE


Dear  GBKEE 版主大大：

　謝謝您費心幫忙，多虧 GBKEE 你 與 Hsieh 大大，鼎力相助，再次謝謝您們了∼
4.gif
我很笨,所以我很用心
　我學藝不精,但我渴求知識

TOP

        靜思自在 : 犯錯出懺悔心，才能清淨無煩惱。
12
返回列表 上一主題