[已解决]怎么用VBA给电脑盘生成目录

wangjianff

电脑E盘有很多电影分别存在从A到Z文件夹中，有的是文件夹，有的直接就是RM，或者AVI。。。格式，我想生成一个目录，通过目录点击超链接就可以直接打开所点击的电影所在的文件夹，有办法办到吗？谢谢

最佳答案

月排行榜 / 总排行榜

wcymiss

2012-9-26 23:12

1. Sub Test()
   
2.     Dim p As String, arr, i As Long
   
3.     Application.ScreenUpdating = False
   
4.     p = "E:"
   
5.     CreateObject("wscript.shell").Run "cmd /c dir /s/b/a-d/on """ & p & "\*.*"">c:\myls.txt", 0, 1
   
6.     Open "c:\myls.txt" For Input As #1
   
7.     arr = Split(StrConv(InputB(LOF(1), #1), vbUnicode), vbCr & vbLf)
   
8.     Close #1
   
9.     Kill "c:\myls.txt"
   
10.     Cells.Clear
    
11.     For i = 1 To UBound(arr)
    
12.         Sheet1.Hyperlinks.Add anchor:=Cells(i, 1), Address:=Left(arr(i - 1), InStrRev(arr(i - 1), "") - 1), TextToDisplay:=arr(i - 1)
    
13.     Next
    
14.     Application.ScreenUpdating = True
    
15. End Sub
    

复制代码

跳转到最佳答案楼层

wcymiss

1. Sub Test()
   
2.     Dim p As String, arr, i As Long
   
3.     Application.ScreenUpdating = False
   
4.     p = "E:"
   
5.     CreateObject("wscript.shell").Run "cmd /c dir /s/b/a-d/on """ & p & "\*.*"">c:\myls.txt", 0, 1
   
6.     Open "c:\myls.txt" For Input As #1
   
7.     arr = Split(StrConv(InputB(LOF(1), #1), vbUnicode), vbCr & vbLf)
   
8.     Close #1
   
9.     Kill "c:\myls.txt"
   
10.     Cells.Clear
    
11.     For i = 1 To UBound(arr)
    
12.         Sheet1.Hyperlinks.Add anchor:=Cells(i, 1), Address:=Left(arr(i - 1), InStrRev(arr(i - 1), "") - 1), TextToDisplay:=arr(i - 1)
    
13.     Next
    
14.     Application.ScreenUpdating = True
    
15. End Sub
    

复制代码