1

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

这是我现在的代码，如何添加超链接功能？我也不介意是否必须添加另一个模块。

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

非常欢迎及时回复，因为我的项目截止日期只有几周了。

谢谢你！

4

1 回答 1

0

您必须将 file.Path 添加到您的记录集，然后当您想将它们链接到循环中时，请尝试以下操作：

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
于 2013-10-02T23:54:52.617 回答