求助：选择文件夹，获取文件夹及子文件夹名里的文件并建立超链接

zuoxingfa

求助：选择文件夹，获取文件夹及子文件夹名里的文件并建立超链接

f8b1987

1. 
   
2. Sub 获取所有子文件夹路径()
   
3.     Dim 文件夹路径 As String
   
4.     Dim 目标表 As Worksheet
   
5.     Dim 行数 As Long
   
6.    
   
7.     ' 设置文件夹路径
   
8.     文件夹路径 = "E:\办公资料\惠州" ' 将路径替换为你要搜索的文件夹路径
   
9.    
   
10.     ' 设置目标表
    
11.     Set 目标表 = ThisWorkbook.Worksheets("Sheet1") ' 根据实际情况修改表名
    
12.    
    
13.     ' 初始化目标表的行数
    
14.     行数 = 1
    
15.    
    
16.     ' 获取文件夹中所有子文件夹的路径
    
17.     获取子文件夹路径 文件夹路径, 目标表, 行数
    
18.    
    
19.     MsgBox "子文件夹路径获取完成！", vbInformation
    
20. End Sub
    
21. 
    
22. Sub 获取子文件夹路径(父文件夹路径 As String, 目标表 As Worksheet, ByRef 行数 As Long)
    
23.     Dim 文件夹 As Object
    
24.     Dim 子文件夹 As Object
    
25.    
    
26.     Set 文件夹 = CreateObject("Scripting.FileSystemObject").GetFolder(父文件夹路径)
    
27.    
    
28.     For Each 子文件夹 In 文件夹.SubFolders
    
29.         目标表.Cells(行数, 1).Value = 子文件夹.Path
    
30.         行数 = 行数 + 1
    
31.         
    
32.         ' 递归调用获取子文件夹中的子文件夹路径
    
33.         获取子文件夹路径 子文件夹.Path, 目标表, 行数
    
34.     Next 子文件夹
    
35. End Sub
    
36. 
    

复制代码

来自AI，已经测试可以使用。
[backcolor=rgba(0, 0, 0, 0.05)]在上述代码中，你需要将文件夹路径[backcolor=rgba(0, 0, 0, 0.05)]变量设置为你要搜索的文件夹的路径。代码将遍历指定文件夹及其所有子文件夹，并将它们的路径写入名为"Sheet1"的工作表中。你可以根据需要修改工作表的名称。

f8b1987

浏览文件夹对话框，可以把文件夹路径这一句改成下面的

1.     ' 弹出浏览文件夹对话框选择文件夹
   
2.     With Application.FileDialog(msoFileDialogFolderPicker)
   
3.         .Title = "请选择文件夹"
   
4.         If .Show = -1 Then
   
5.             文件夹路径 = .SelectedItems(1)
   
6.         Else
   
7.             Exit Sub
   
8.         End If
   
9.     End With

复制代码

zuoxingfa

f8b1987 发表于 2023-12-28 08:32
来自AI，已经测试可以使用。
在上述代码中，你需要将文件夹路径变量设置为你要搜索的文件夹的路径。代码将 ...

感谢帮助，不能获取文件。

zuoxingfa

f8b1987 发表于 2023-12-28 08:35
浏览文件夹对话框，可以把文件夹路径这一句改成下面的

加上这个，只能获取一次。

gwjkkkkk

请参考附件。。。

zuoxingfa

gwjkkkkk 发表于 2023-12-28 22:43
请参考附件。。。

感谢，符合要求。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()      '//2023.12.29
   
2.     Dim fns As New Collection
   
3.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
4.     With Application.FileDialog(msoFileDialogFolderPicker)
   
5.         .Title = "请选择文件夹"
   
6.         .InitialFileName = ThisWorkbook.Path & ""
   
7.         If .Show = -1 Then
   
8.             p = .SelectedItems(1) & ""
   
9.         End If
   
10.     End With
    
11.     Set ff = Fso.GetFolder(p)
    
12.     Call GetFiles(ff, fns, Fso)
    
13.     m = 1
    
14.     ActiveSheet.UsedRange.Offset(1).Clear
    
15.     For Each f In fns
    
16.         m = m + 1
    
17.         Cells(m, 1) = f(0)
    
18.         Cells(m, 2) = f(1)
    
19.         Cells(m, 3) = f(2)
    
20.         ActiveSheet.Hyperlinks.Add Anchor:=Cells(m, 2), Address:=f(3)
    
21.     Next
    
22.     Range("a1:c" & m).Borders.LineStyle = 1
    
23. End Sub
    
24. 
    
25. Function GetFiles(ff, fns, Fso)
    
26.     For Each f In ff.Files
    
27.         If InStr(f, "~$") = 0 Then
    
28.             If InStr(f, ThisWorkbook.Name) = 0 Then
    
29.                 fns.Add Array(ff.Path, f.Name, "." & Fso.GetExtensionName(f), f.Path)
    
30.             End If
    
31.         End If
    
32.     Next
    
33.     For Each fd In ff.SubFolders
    
34.         Call GetFiles(fd, fns, Fso)
    
35.     Next
    
36. End Function
    

复制代码

ykcbf1100

参与一下，遍历文件法

zuoxingfa

ykcbf1100 发表于 2023-12-29 10:13
参与一下，遍历文件法

感谢，帮助！！！！！！！！！！