龙空技术网

创建指定文件夹内指定文件的超链接

张小李 117

前言:

此时小伙伴们对“超链接的代码”大体比较珍视,小伙伴们都想要知道一些“超链接的代码”的相关知识。那么小编也在网摘上汇集了一些关于“超链接的代码””的相关知识,希望各位老铁们能喜欢,小伙伴们一起来学习一下吧!

PS:本代码可以选择文件名的关键字和后缀,支持模糊选择,即选择文件名中关键字即可,如果没有关键字选取所有文件,可以输*或者ESC退出,不影响使用。

如果只有文件清单不需要超链接,代码中可自行更改,已注释。

创新的超链接,默认在A列最后一个单位格的下方

===============================

Sub 文件名清单含子目_超链接()

'Columns(1).Delete

On Error Resume Next

Dim f As String

Dim file() As String

Dim i, k, x, fp

x = Application.CountIf([A:A], "<>") + 1

i = 1: k = 1

Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFolderPicker)

With fd

.InitialFileName = ActiveWorkbook.Path

If .Show = -1 Then fp = .SelectedItems(1) 'fp = 如果进行了选择并确认,选中的文件夹地址

End With

ReDim file(1 To i)

file(1) = fp & "\"

a = InputBox("请输入文件名关键词")

b = InputBox("请输入文件后缀")

Do Until i > k

f = Dir(file(i), vbDirectory)

Do Until f = ""

If InStr(f, ".") = 0 Then

k = k + 1

ReDim Preserve file(1 To k)

file(k) = file(i) & f & "\"

End If

f = Dir

Loop

i = i + 1

Loop

For i = 1 To k

f = Dir(file(i) & "*" & a & "*.*" & b & "*") '想要抓取的文件关键词\后缀等

Do Until f = ""

'Range("a" & x) = f '选这个就是非超链接

Range("a" & x).Hyperlinks.ADD Anchor:=Range("a" & x), Address:= _

file(i) & f, TextToDisplay:=f

x = x + 1

f = Dir

Loop

Next

End Sub

标签: #超链接的代码