Vba Excel宏列出包含目录中的所有文件并对其进行超链接
我已经有一个宏,但我需要它也超链接U列中的文件以及a列中的文件列表 这是我现在的代码,如何添加超链接功能? 我也不介意我是否必须添加另一个模块Vba Excel宏列出包含目录中的所有文件并对其进行超链接,vba,excel,hyperlink,Vba,Excel,Hyperlink,我已经有一个宏,但我需要它也超链接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
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
及时回复将是非常受欢迎的,因为我的项目截止日期只有几周了
谢谢大家! 您必须将file.Path添加到记录集,然后当您想在循环中链接它们时,请尝试以下操作:
ActiveSheet.Hyperlinks.Add Anchor:=Cells(row, 1), Address:=file.Path, TextToDisplay:=name
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
编辑
在rs.AddNew之后添加此行:
rs("Path") = file.Path
再添加一个附加:
With rsFSO.Fields
.Append "Path", 200, 200
.Append "Name", 200, 200
.Append "Type", 200, 200
End With
现在将这部分代码更改为:
ActiveSheet.Hyperlinks.Add Anchor:=Cells(row, 1), Address:=file.Path, TextToDisplay:=name
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
看看您是否使用记录集作为数组替换?在以前的代码中,我将把这段代码放在哪里?很抱歉,这是VB的新代码。请参见上面的编辑,您必须更改一些不同的部分。请告诉我您遇到了哪些错误以及它们来自哪些行。是否在与请求的名称或序号对应的集合中找不到您所说的和我得到的运行时3265项突出显示rsPath=file。路径在rs.addnewSee我上次编辑后,我忘了添加此项:。追加路径,200,200