vba - 目录文件列表和超链接器没有超链接权

Question

您好现在已经研究了一段时间，我似乎无法弄清楚为什么我的代码使文本看起来像超链接，但实际上并没有链接正确的路径。

Sub hyperlinker()

  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
  Dim path 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 "path", 200, 200
    .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
    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

   '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("Path") = path
    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

请帮助使超链接成为实际的超链接。

Answer 1

谢谢@Arich

为我指明了正确的方向。

希望是最终代码！

Sub hyperlinker()

  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
  Dim path 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 "path", 200, 200
    .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
    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

  '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)

    Dim path As String
    path = Mid(file.path, Len(parent.path) + 2)

    rs.AddNew
    rs("Path") = path
    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

只是在最后添加了“Dim path as string”，它似乎将路径与超链接挂钩。