vba Excel 宏列出包含目录中的所有文件并超链接它们
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19148596/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel Macro listing all files within the contained directory and hyperlinking them
提问by Josiah Cowden
I have a macro already however i need it to also hyperlink the files in column U along with the file list in column A.
我已经有一个宏，但是我还需要它来超链接 U 列中的文件以及 A 列中的文件列表。
Here is my code right now, how can i add the hyperlinking feature? i don't mind if I have to add another module either.
这是我现在的代码，如何添加超链接功能？我也不介意我是否必须添加另一个模块。
Sub ListFilesAndSubfolders()
Dim FSO As Object
Dim rsFSO As Object
Dim baseFolder As Object
Dim file As Object
Dim folder As Object
Dim row As Integer
Dim name As String
'Get the current folder
Set FSO = CreateObject("scripting.filesystemobject")
Set baseFolder = FSO.GetFolder(ThisWorkbook.Path)
Set FSO = Nothing
'Get the row at which to insert
row = Range("A65536").End(xlUp).row + 1
'Create the recordset for sorting
Set rsFSO = CreateObject("ADODB.Recordset")
With rsFSO.Fields
.Append "Name", 200, 200
.Append "Type", 200, 200
End With
rsFSO.Open
' Traverse the entire folder tree
TraverseFolderTree baseFolder, baseFolder, rsFSO
Set baseFolder = Nothing
'Sort by type and name
rsFSO.Sort = "Type ASC, Name ASC "
rsFSO.MoveFirst
'Populate the first column of the sheet
While Not rsFSO.EOF
name = rsFSO("Name").Value
If (name <> ThisWorkbook.name) Then
Cells(row, 1).Formula = name
row = row + 1
End If
rsFSO.MoveNext
Wend
'Close the recordset
rsFSO.Close
Set rsFSO = Nothing
End Sub
Private Sub TraverseFolderTree(ByVal parent As Object, ByVal node As Object, ByRef rs As Object)
'List all files
For Each file In node.Files
Dim name As String
name = Mid(file.Path, Len(parent.Path) + 2)
rs.AddNew
rs("Name") = name
rs("Type") = "FILE"
rs.Update
Next
'List all folders
For Each folder In node.SubFolders
TraverseFolderTree parent, folder, rs
Next
End Sub
prompt replies would be very welcome as my project deadline is only a few weeks off.
非常欢迎及时回复，因为我的项目截止日期只有几周的时间。
thank you!
谢谢你！
采纳答案by Portland Runner
You'll have to add the file.Path to your record set and then when you want to link them in your loop try something like this:
您必须将 file.Path 添加到您的记录集，然后当您想在循环中链接它们时，请尝试以下操作：
ActiveSheet.Hyperlinks.Add Anchor:=Cells(row, 1), Address:=file.Path, TextToDisplay:=name
Edit
编辑
After rs.AddNew add this line:
在 rs.AddNew 之后添加这一行：
rs("Path") = file.Path
Add one more append:
再添加一个附加：
With rsFSO.Fields
.Append "Path", 200, 200
.Append "Name", 200, 200
.Append "Type", 200, 200
End With
Now change this part of your code like this:
现在像这样更改这部分代码：
While Not rsFSO.EOF
name = rsFSO("Name").Value
path = rsFSO("Path").Value
If (name <> ThisWorkbook.name) Then
ActiveSheet.Hyperlinks.Add Anchor:=Cells(row, 1), Address:=path, TextToDisplay:=name
row = row + 1
End If
rsFSO.MoveNext
Wend
You might have to add the definition at the top of your code like this:
您可能需要在代码顶部添加定义，如下所示：
dim path as string
