Excel宏列出所包含目录中的所有文件并将其超链接 [英] Excel Macro listing all files within the contained directory and hyperlinking them
问题描述
我已经有了一个宏,但我还需要它来链接U列中的文件以及A列中的文件列表。
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.
这是我现在的代码,我该如何添加超链接功能?
i不介意我是否必须添加另一个模块。
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.
谢谢!
推荐答案
你必须添加file.Pa th到你的记录集然后当你想在你的循环中链接它们时尝试这样的事情:
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:
ActiveSheet.Hyperlinks.Add Anchor:=Cells(row, 1), Address:=file.Path, TextToDisplay:=name
编辑
Edit
在rs.AddNew之后添加以下行:
After rs.AddNew add this line:
rs("Path") = file.Path
再添加一个附加:
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
这篇关于Excel宏列出所包含目录中的所有文件并将其超链接的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!