Excelmacros列出了包含的目录中的所有文件并将它们超链接

我已经有一个macros，但是我需要它也超链接列U中的文件以及列A中的文件列表。

这里是我的代码现在，我如何添加超链接function？ 我不介意如果我不得不添加另一个模块。

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 

及时回复将是非常受欢迎的，因为我的项目截止date只有几个星期了。

谢谢！

Answer 1

你将不得不添加file.Path到你的logging集，然后当你想在你的循环链接他们尝试这样的事情：

 ActiveSheet.Hyperlinks.Add Anchor:=Cells(row, 1), Address:=file.Path, TextToDisplay:=name 

---

编辑

在rs.AddNew之后添加这一行：

 rs("Path") = file.Path 

添加一个附加：

 With rsFSO.Fields .Append "Path", 200, 200 .Append "Name", 200, 200 .Append "Type", 200, 200 End With 

现在改变你的代码的这一部分，如下所示：

  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 

您可能需要像这样在代码顶部添加定义：

 dim path as string