VBA获取文件夹在单元格并添加超链接

天真无鞋

求助老师帮忙写代码，详见附加文件，谢谢。

wang-way

获取第几层 文件夹 你没说清楚

wang-way

1. ''给你参考一下吧
   
2. Public Sub X()
   
3.     '''代码从这里开始写
   
4.     Dim Fso
   
5.     Set Fso = CreateObject("scripting.filesystemobject")
   
6.     Set fd = Fso.GetFolder(ThisWorkbook.Path)
   
7.    
   
8.     Debug.Print fd.Path
   
9.     For Each fd1 In fd.subfolders
   
10.         'A列 fd1.Path
    
11.         Debug.Print fd1.Path
    
12.         For Each fd2 In fd1.subfolders
    
13.             Debug.Print fd2.Path
    
14.         Next fd2
    
15.         
    
16.     Next fd1
    
17.    
    
18. End Sub
    
19. '''过程结束

复制代码

天真无鞋

wang-way 发表于 2024-7-24 15:54
获取第几层 文件夹 你没说清楚

只获取2层文件夹，主文件夹和次文件夹，其他都不需要，谢谢。

天真无鞋

wang-way 发表于 2024-7-24 15:54
获取第几层 文件夹 你没说清楚

打开地址为第一层文件夹，然后在获取第二层文件夹即可。

wang-way

ykcbf1100

参与一下，文件夹超链接

ykcbf1100

参与一下，超链接

1. Sub ykcbf()   '//2024.7.24    获取文件夹名,作加上超链接
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     p = ThisWorkbook.Path & ""
   
5.     On Error Resume Next
   
6.     m = 1: n = 1
   
7.     [a2:c1000].Clear
   
8.     Columns("B:C").NumberFormatLocal = "@"
   
9.     For Each fd In fso.GetFolder(p).SubFolders
   
10.         m = m + 1
    
11.         Cells(m, 2) = fd.Name
    
12.         p1 = p & fd.Name & ""
    
13.         d1 = Cells(m, 2)
    
14.         ActiveSheet.Hyperlinks.Add Anchor:=Cells(m, 2), Address:="file://" & p1, TextToDisplay:=d1
    
15.         For Each fd1 In fd.SubFolders
    
16.             n = n + 1
    
17.             Cells(n, 3) = CStr(fd1.Name)
    
18.             p2 = p1 & fd1.Name & ""
    
19.             d2 = CStr(Cells(n, 3))
    
20.             ActiveSheet.Hyperlinks.Add Anchor:=Cells(n, 3), Address:="file://" & p2, TextToDisplay:=d2
    
21.         Next
    
22.     Next
    
23.     Application.ScreenUpdating = True
    
24.     MsgBox "OK！"
    
25. End Sub
    
26. 
    

复制代码

天真无鞋

ykcbf1100 发表于 2024-7-24 16:42
参与一下，文件夹超链接

感谢老师非常正确，能否帮忙把获取当前工作簿路径改为局域网地址，谢谢。

ykcbf1100

天真无鞋 发表于 2024-7-24 16:56
感谢老师非常正确，能否帮忙把获取当前工作簿路径改为局域网地址，谢谢。

局域网地址我不了解啊，我平时很少用的。