批量替换400个文件中不同的超链接

Sub GetHyperlinksFromFiles()
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim hlink As Hyperlink
    Dim outputRow As Long
    Dim targetFolder As String
    
    targetFolder = "D:\ExcelFiles" '修改为你的实际文件夹路径
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(targetFolder)
    
    Set ws = ThisWorkbook.Worksheets(1) '假设输出到当前工作簿的第一个工作表
    
    outputRow = 1
    
    For Each file In folder.Files
        If Right(file.Name, 5) = ".xlsx" Or Right(file.Name, 4) = ".xls" Then '只处理 Excel 文件
            Set wb = Workbooks.Open(file.Path)
            For Each ws In wb.Worksheets
                For Each hlink In ws.Hyperlinks
                    ws.Cells(outputRow, 1).Value = file.Name '文件名
                    ws.Cells(outputRow, 2).Value = hlink.Address '旧超链接
                    outputRow = outputRow + 1
                Next hlink
            Next ws
            wb.Close False
        End If
    Next file
End Sub

Sub ReplaceHyperlinks()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
    Set ws = ThisWorkbook.Worksheets(1) '假设在当前工作簿的第一个工作表中操作
    
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To lastRow
        Dim oldLink As String
        Dim newLink As String
        oldLink = ws.Cells(i, 2).Value
        newLink = ws.Cells(i, 3).Value
        If oldLink <> "" And newLink <> "" Then
            ReplaceHyperlinkInWorkbook oldLink, newLink
        End If
    Next i
End Sub

Sub ReplaceHyperlinkInWorkbook(oldLink As String, newLink As String)
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim hlink As Hyperlink
    
    For Each wb In Workbooks
        For Each ws In wb.Worksheets
            For Each hlink In ws.Hyperlinks
                If hlink.Address = oldLink Then
                    hlink.Address = newLink
                End If
            Next hlink
        Next ws
    Next wb
End Sub