实用VBA：19.Excel一键修复文件链接-易微帮

1.需求场景

此前与大家分享过一键提取文件目录和文件名的方法，并且VBA中加一句语句就可以使提取出来的文件名带有链接，这样很方便在对大量文件进行检查时不必在资源管理器里到处翻目录，所见即所得，点击文件名即可打开文件。是个实际工作中非常实用的小技巧。但是有时候由于将保存目录信息的excel文件移动到了其他目录下或者分享至其他计算机等原因，常常遇到文件链接失效的情况。此时，也可以通过简单的VBA实现一键修复链接。

2.解决思路

一键提取文件路径和文件名的方法在此前的文章中与大家分享过（实用VBA：6.一键批量提取文件名和存储路径_批量存储文件名-CSDN博客）。在此代码的基础上，将其中注释掉的那一句的注释取消即可实现文件名带链接就是这句：

'ws.Hyperlinks.Add anchor:=ws.Cells(last_row, 2), Address:=fso.Path & "\" & file.Name

在这个范例的基础上，如果文件名链接失效了，我们就可以将A列的文件路径和B列的文件名重新组合为文件完整路径，将其添加为B列单元格内容（文件名）的链接。

当然也可以使用一键提取的方法重新提取带链接的文件名和路径，但是如果之前已经提取过的路径没有变化，仅是链接失效了，就可以采用这里介绍的方法修复链接。文件很多的时候用这个修复的方法速度更快。况且原来提取的很多文件和路径可能是从多个根目录下多次提取出来的，修复的话就更加节省了多次提取的时间。

例如，修复前的表格如下（不含链接）

3.VBA实现

Option Explicit



Dim wb As Workbook

Dim ws As Worksheet



'在已提取文件路径和文件名的基础上修复文件名与文件的链接

Sub B修复链接()

'定义循环变量

Dim i As Integer

    '设置工作簿为当前工作簿

    Set wb = Workbooks(1)

    '设置文件路径信息保存在“文件列表”表格中

    Set ws = Worksheets("文件列表")

    

    '取消当前工作表中所有单元格的链接

    'ws.Hyperlinks.Delete

    

    '处理第2-13行的信息

    For i = 2 To 13

        '将每行A列与B列拼接出的文件完成路径作为链接信息赋予B列文件名所在单元格

        ws.Hyperlinks.Add anchor:=ws.Cells(i, 2), Address:=ws.Cells(i, 1).Value & ws.Cells(i, 2).Value

    Next i

    

    '释放工作表变量

    Set ws = Nothing

    '释放工作簿变量

    Set wb = Nothing

    

    '输出提示信息

    MsgBox "链接更新完毕。"

   

End Sub