使用VBA自动修复重命名移动后损坏的Excel工作簿外部链接

该功能完全可以实现。由于两个重命名后的工作簿始终存放在同一文件夹内，只需通过VBA动态获取当前工作簿所在路径，匹配目标工作簿的名称规则，即可批量更新所有外部链接。

前提说明 #

• 提前确定两个工作簿的固定命名规则：比如项目规划工作簿命名规则为「[客户名]-项目规划.xlsm」，数据源工作簿命名规则为「[客户名]-数据源.xlsx」，VBA可通过替换当前文件名的固定后缀自动匹配目标文件名
• 项目规划工作簿需要保存为xlsm格式（启用宏的工作簿）才能存储VBA代码
• 打开文件时如果顶部出现安全警告，点击「启用内容」才能正常运行宏

具体实现步骤 #

步骤1：插入按钮与宏模块 #

• 打开你的项目规划工作簿，点击「开发工具」选项卡 → 「插入」→ 选择表单控件里的「按钮（窗体控件）」
• 在工作表合适位置绘制按钮，弹出「指定宏」窗口时点击「新建」，自动跳转到VBA编辑器

步骤2：粘贴VBA代码 #

把以下代码粘贴到自动生成的模块中，按需修改代码里的命名规则部分：

Sub 一键重连数据源链接()
    Dim currentPath As String
    Dim targetFileName As String
    Dim oldLink As Variant
    ' 获取当前工作簿所在文件夹路径
    currentPath = ThisWorkbook.Path & "\"
    ' --------------------------
    ' 此处修改为你自己的命名规则
    ' 示例逻辑：当前规划簿命名是「客户名-项目规划.xlsm」，数据源是「客户名-数据源.xlsx」
    ' 把当前文件名里的"-项目规划.xlsm"替换为"-数据源.xlsx"，得到目标数据源文件名
    targetFileName = Replace(ThisWorkbook.Name, "-项目规划.xlsm", "-数据源.xlsx")
    ' 特殊场景：如果数据源文件名存在当前工作簿的某个单元格（比如B2单元格），可替换为下面的代码
    ' targetFileName = Range("B2").Value
    ' --------------------------
    ' 检查目标数据源文件是否存在
    If Dir(currentPath & targetFileName) = "" Then
        MsgBox "同文件夹下未找到对应数据源工作簿，请确认文件命名是否符合规则", vbExclamation
        Exit Sub
    End If
    ' 遍历所有外部链接，批量更新链接地址
    For Each oldLink In ThisWorkbook.LinkSources(xlExcelLinks)
        ThisWorkbook.ChangeLink Name:=oldLink, NewName:=currentPath & targetFileName, Type:=xlExcelLinks
    Next oldLink
    MsgBox "链接更新完成！", vbInformation
End Sub

步骤3：功能测试 #

• 保存项目规划工作簿为xlsm格式
• 把两个工作簿按客户名重命名后复制到新文件夹，打开项目规划工作簿，点击插入的按钮即可自动完成链接更新

内容的提问来源于stack exchange，提问作者ReganK1998