AW: Verknüpfungsliste auf >1 Ebene
11.05.2022 10:30:13
UweD
Hallo Bernd
hier mal eine Lösung für die aktuelle Datei plus EINE weitere Ebene
Wenn in der 2. Ebene weiter geprüft werden müssen, dann müsstest du das in einen "Loop until" packen
Sub Finde_Verkn()
Dim Wb2 As Workbook, TB2 As Worksheet
Dim vLinks1 As Variant, vLinks2 As Variant
Dim i As Integer, j As Integer, z As Integer
vLinks1 = ThisWorkbook.LinkSources(xlExcelLinks)
z = 2
If Not IsEmpty(vLinks1) Then
Set TB2 = ThisWorkbook.Sheets.Add(after:=Sheets(Sheets.Count))
TB2.Cells(1, 1) = "Verknüpfungen"
For i = 1 To UBound(vLinks1)
TB2.Cells(z, 1) = vLinks1(i)
z = z + 1
Set Wb2 = Workbooks.Open(vLinks1(i))
vLinks2 = Wb2.LinkSources(xlExcelLinks)
If Not IsEmpty(vLinks2) Then
For j = 1 To UBound(vLinks2)
TB2.Cells(z, 2) = vLinks2(j)
z = z + 1
Next j
End If
Wb2.Close False
Next i
Else
MsgBox "Diese Arbeitsmappe enthält keine Verknüpfungen!"
End If
End Sub
LG UweD