在 excel 中使用 VBA 更改多个链接的源-解网

问：

我是 VBA 的新手，负责为我的团队创建一个宏，以更新单个工作簿中的多个（26）个外部链接。我想要一个新链接和旧链接的表格。宏应该匹配它们，新的应该替换旧的“更改源”。

我最终到达了这一点，但它需要 1 个新链接，并用这个新链接替换所有旧链接。

Sub Update_Links()
    Dim varNewLink As Variant
    Dim lnk As Variant
    
    Application.Goto Reference:="Links_Sheet"
    ' get all links
    lnk = ActiveWorkbook.LinkSources(xlExcelLinks)
    
    If Not IsEmpty(lnk) Then
        ' prompt for the new file for the link
        varNewLink = Application.GetOpenFilename("J:\Capital Production\01 2021\04 Q4 Reporting\03 Assets\08 Counterparty_Concentration\02_Counterparty\01_SH\01 Counterparty Exposure Record\Q321 Counterparty exposure record (*****) v0.2_no links.xlsm")
        ' if user didn't cancel, refresh the link
        If varNewLink <> False Then
            
            ActiveWorkbook.ChangeLink Name:=lnk(1), NewName:=varNewLink, _
                                      Type:=xlExcelLinks
            
        End If
    End If
End Sub

VBA Excel-2007

Sub UpdateLinks()

    Dim aLinks As Variant, vLink As Variant
    Dim rFoundLink As Range
    Dim rSrchRange As Range
    Dim MissingLinks As String
    
    'A list of your existing links that need updating.
    Set rSrchRange = ThisWorkbook.Worksheets("Sheet1").Range("A3:A4")

    'Links that are in your workbook.
    aLinks = ThisWorkbook.LinkSources(xlExcelLinks)
    
    If Not IsEmpty(aLinks) Then
        For Each vLink In aLinks
            Set rFoundLink = rSrchRange.Find(vLink, , xlValues, xlWhole, xlByRows, xlNext, False) 'Find the link in your list.
            If Not rFoundLink Is Nothing Then
                'If the link is found then update it to the link in the next column.
                ThisWorkbook.ChangeLink Name:=vLink, NewName:=rFoundLink.Offset(, 1), Type:=xlExcelLinks
            Else
                'If the link isn't found in your list then add it to a message string.
                MissingLinks = MissingLinks & vLink & vbCr
            End If
        Next
    End If

    'Any links that didn't update are displayed in a message.
    If MissingLinks <> "" Then
        MsgBox MissingLinks
    End If

End Sub

如果要更新所有链接以查看同一工作簿，则不需要 FIND 链接部分：

Sub UpdateLinks()

    Dim aLinks As Variant, vLink As Variant

    'Links that are in your workbook.
    aLinks = ThisWorkbook.LinkSources(xlExcelLinks)
    
    If Not IsEmpty(aLinks) Then
        For Each vLink In aLinks
            ThisWorkbook.ChangeLink Name:=vLink, NewName:="H:\Darren Bartrup-Cook\Test\Book1.xlsm", Type:=xlExcelLinks
        Next
    End If

End Sub

在 excel 中使用 VBA 更改多个链接的源

Change source using VBA in excel for multiple links

评论

评论