AW: Erstellung Inhaltsverzeichnis aller Verknüpfungen
16.07.2009 11:44:42
Jogy
Hi.
Ich lasse das mal in die Tabelle "Links" schreiben (legt es an, wenn nicht vorhanden):
'Liest alle Verknüfungen aus und schreibt sie in ein neues Arbeitsblatt
Sub writeLinks()
Dim myLinks
Dim linkConst
Dim i As Integer
Dim j As Integer
Dim schreibZeile As Long
Dim linkWsh As Worksheet
Application.ScreenUpdating = False
linkConst = Array(xlExcelLinks, xlOLELinks, xlPublishers, xlSubscribers)
schreibZeile = 2
' Legt ein Worksheet namens Links an, falls nicht vorhanden
On Error Resume Next
Set linkWsh = ActiveWorkbook.Worksheets("Links")
On Error GoTo 0
If linkWsh Is Nothing Then
Set linkWsh = ActiveWorkbook.Worksheets.Add(, ActiveWorkbook.Sheets(Sheets.Count))
linkWsh.name = "Links"
Else
linkWsh.Cells.ClearContents
End If
On Error GoTo 0
With linkWsh
For i = 0 To UBound(linkConst)
' Links lesen
myLinks = ActiveWorkbook.LinkSources(linkConst(i))
' Links schreiben
If Not IsEmpty(myLinks) Then
For j = 1 To UBound(myLinks)
.Cells(schreibZeile, 1) = myLinks(j)
' Fehlerbehandlung aus, falls Zugriffsfehler
On Error Resume Next
.Cells(schreibZeile, 2) = FileDateTime(myLinks(j))
On Error GoTo 0
schreibZeile = schreibZeile + 1
Next
End If
Next
' Wenn was geschrieben wurde, dann noch Überschrift und Formatierung
If schreibZeile > 2 Then
.Cells(1, 1) = "Dateiname"
.Cells(1, 2) = "Änderungsdatum"
.Range(.Cells(1, 1), .Cells(1, 2)).EntireColumn.AutoFit
Else
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
End With
Application.ScreenUpdating = True
End Sub
Gruss, Jogy