模糊查询文件夹下文件名并把结果输入到目录树

EXCEL江湖

1、在文本框中输入文件名（可以是部分），查找文件夹下文件名，如有相似的，则把这些文件名写入到treeview中，并列出其中表名在下一级菜单中。文件名按文本方式排序！

2、单击节点，复制表内容到样表。 文本框查找生成目录树.rar (40.18 KB, 下载次数: 145)

2014-8-24 17:09 上传

点击文件名下载附件

请群里的朋友帮助解答，谢谢！

excel333

这里有例子：


http://club.excelhome.net/thread-1116913-1-1.html

百度不到去谷歌

没记错的话 生成目录树我已经给你写过了吧 把生成树之前输入范围改为你搜索后匹配的到的文件数组不就完了

EXCEL江湖

百度不到去谷歌老师，你好！还不太懂您写的递归程序，不知在哪个地方修改，另还想生成工作表的内容，麻烦您帮忙看看！谢谢！

百度不到去谷歌

几分钟就改好了  另外拜托不要乱叫版主  我可不是版主！！这个不用设置搜索按钮了 文本框输进去 即时搜索

1. Option Compare Text
   
2. 
   
3. 
   
4. Sub TvInPut(ByVal TV As TreeView, arr)
   
5. '从数组读取数据写入到目录树
   
6.     Dim i&, parKey$, k
   
7.     Dim nodex As Node
   
8.     Set TV.ImageList = Nothing
   
9.     TV.Nodes.Clear
   
10.     If arr(1) = "" Then Exit Sub
    
11.     'TV.Nodes.Add , , "VBA代码助手", "VBA代码助手" '加入根节点
    
12.     For i = 1 To UBound(arr)
    
13.         TvInPutIterate TV, arr(i)
    
14.     Next
    
15.     TV.Nodes(1).EnsureVisible
    
16. End Sub
    
17. Sub TvInPutIterate(ByVal TV As TreeView, key) '递归构造树
    
18. '从数组读取数据写入到目录树
    
19.     Dim i&, parKey$, k
    
20.     'TV.Nodes.Add , , "VBA代码助手", "VBA代码助手" '加入根节点
    
21.     k = InStrRev(key, "-")
    
22.     If k = 0 Then '顶层
    
23.         TV.Nodes.Add(, , key, key).EnsureVisible
    
24.     Else
    
25.         parKey = Left(key, k - 1) '获得父节点关键字
    
26.         On Error Resume Next
    
27.         TV.Nodes(parKey).Tag = parKey
    
28.         If Err <> 0 Then '父节点不存在会发生错误，则递归向前构造父节点
    
29.             TvInPutIterate TV, parKey
    
30.             Err.Clear
    
31.         End If
    
32.         On Error GoTo 0
    
33.         TV.Nodes.Add(parKey, tvwChild, key, Mid(key, k + 1)).EnsureVisible
    
34.     End If
    
35. End Sub
    
36. 
    
37. Private Sub TextBox1_Change()
    
38.     Call TvInPut(TreeView1, filelist(ThisWorkbook.path & "\文件", TextBox1))
    
39. End Sub
    
40. 
    
41. Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
    
42.     On Error Resume Next '复制节点对应的文件
    
43.     Dim path$
    
44.     path = ThisWorkbook.path & "\文件" + Node.FullPath + ".xls"
    
45.     Application.ScreenUpdating = False
    
46.     If Dir(path) <> "" Then
    
47.         With GetObject(path)
    
48.             .Sheets(1).Cells.Copy ThisWorkbook.Sheets("样表").Cells
    
49.             .Close
    
50.         End With
    
51.     End If
    
52.     Application.ScreenUpdating = True
    
53. End Sub
    
54. Private Sub UserForm_Initialize()
    
55.     TreeView1.PathSeparator = "-"
    
56.     TvInPut TreeView1, filelist(ThisWorkbook.path + "\文件", "") 'tree初始化
    
57.     TreeView1.Sorted = True
    
58. End Sub
    
59. Private Function filelist(folderspec, ByVal p$)
    
60.     Dim fs, f, f1, fc, s, arr, i
    
61.     Set fs = CreateObject("Scripting.FileSystemObject")
    
62.     Set f = fs.GetFolder(folderspec)
    
63.     Set fc = f.Files
    
64.     ReDim arr(1 To fc.Count)
    
65.     i = 0
    
66.     For Each f1 In fc
    
67.         If f1.Name Like ("*" + p + "*") Then i = i + 1: arr(i) = Left(f1.Name, Len(f1.Name) - 4)
    
68.     Next
    
69.     If i = 0 Then i = 1
    
70.     ReDim Preserve arr(1 To i)
    
71.     filelist = arr
    
72.     Set fs = Nothing
    
73. End Function
    

复制代码

treeview与文件夹目录.rar (47.98 KB, 下载次数: 331)

2014-8-24 21:00 上传

点击文件名下载附件

EXCEL江湖

老师，您太厉害了，这真叫会者不难呀！如果每个工作簿有多个工作表，那如何生成再下一级的菜单呀！

EXCEL江湖

我之前也想修改您的那个自定义函数，但总出错，所以不得已求助！

EXCEL江湖

贴沉得太快，还请坛里的老师帮忙再修改下！希望有工作簿下工作表的目录！谢谢！