Verknüpfungen aller Dateien listen

Hallo Forum,
ich habe folgendes Problem. In unserer Firma soll ein Ordner (Vertrieb) im Netzwerk komplett verschoben werden. In diesem Ordner (Vertrieb) existieren
mehrere Ordner, Unterordner und Dateien. In allen Ordnern sind Excell-Dateien
vorhanden die miteinander Verknüpft sind.
Jetzt habe ich mir gedacht um nach dem verschieben des Ordners (Vertrieb)
die Verknüpfungen zu aktuallisieren das ich mir alle vorhandene Verknüpfungen
liste um zu wissen wo überhaupt Verknüpfungen existieren.
Wie kann ich mir diese listen aus allen Dateien des Ordners (Vertrieb)?
Oder ist es möglich nach dem verschieben des Ordners (Vertrieb) mit Hilfe
eines Makros die alte Verknüpfungen zu aktuallisieren? Der alte Pfad lautet
z.Z. \\Firma\Server\Bereiche\Aussendienst\Vertrieb\
der neue Pfad soll dann sein: \\Firma\Vertrieb\
Da hatte ich mir gedacht wie bei dem Ersetzen, das \\Firma\Server\Bereiche\Aussendienst\Vertrieb\ durch \\Firma\Vertrieb\ ersetzt
wird.
Kann das durch ein Makro gelöst werden?
Hat jemand eine Idee?
Danke
Bernd

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Bernd
hab hier schon mal was gefunden was allerdings nur dieses Sheet durchsucht.
Ich hab da auch nicht so die Ahnung davon aber vieleicht kann dir ja ein anderer
hier weiterhelfen und den Code so umschreiben das bei dir alle Dateien und alle
Sheets durchsucht wird. Ansonsten ist es schon fast das was du suchst.
Ich lasse die Frage mal als geöffnet damit sich andere den Code ansehen können
und ihn mit FileSearch versehen können.
Viel Erfolg
Jan
Sub LinkInfo()
Dim arrDetails As Variant
Dim rng As Range, rngSel As Range
Dim iCounter As Integer, iRow As Integer, sText As String
Set rngSel = Range("A1:IV65536")
Workbooks.Add 1
Range("A1").Value = "LinkAddress:"
Range("B1").Value = "Path:"
Range("C1").Value = "Workbook:"
Range("D1").Value = "Worksheet:"
Range("E1").Value = "Range:"
Range("A1:E1").Font.Bold = True
iRow = 1
For Each rng In rngSel
If rng.HasFormula Then
If InStr(rng.Formula, "\[") Then
arrDetails = GetDetails(rng.Formula)
iRow = iRow + 1
Cells(iRow, 1).Value = rng.Address
For iCounter = 1 To 4
Cells(iRow, iCounter + 1).Value = arrDetails(iCounter)
Next iCounter
End If
End If
Next rng
Columns.AutoFit
End Sub


Private Function GetDetails(sTxt As String) As Variant
Dim sWkb As String, sWks As String, sRng As String
Dim sPath As String
Dim arr(1 To 4) As String
arr(1) = Mid(sTxt, InStr(sTxt, "'") + 1, _
InStr(sTxt, "[") - InStr(sTxt, "'") - 2)
arr(2) = Mid(sTxt, InStr(sTxt, "[") + 1, _
InStr(sTxt, "]") - InStr(sTxt, "[") - 1)
arr(3) = Mid(sTxt, InStr(sTxt, "]") + 1, _
InStr(sTxt, "'!") - InStr(sTxt, "]") - 1)
arr(4) = Right(sTxt, Len(sTxt) - InStr(sTxt, "!"))
GetDetails = arr
End Function

Beliebteste Forumthreads (12 Monate)

Verknüpfungen aller Dateien listen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread