Hallo! 

Ich stehe vor folgender Herausforderung: Auf dem Pfad C:/Ordner befindet sich ein Ordner mit dutzenden Unterordnern (die weitere Unterordner haben) und darin liegen hunderte Excel-Dateien, die sich mit externen Verknüpfungenkreuz und quer aufeinander beziehen.

Nun soll die komplette Datenstruktur von C:/Ordner auf D:/Ordner verschoben werden. Dazu ist von Nöten, dass alle Verknüpfungen, die sich in den Excel-Dateien befinden aktualisiert werden - in der Form, dass eine Beispielhafte Verknüpfung "C:/Ordner/Unterordner1/Datei1" durch "D:/Ordner/Unterordner1/Datei1" ersetzt werden. Im Prinzip also in jeder Verknüpfung die Zeichenkette "C:/Ordner" durch "D:/Ordner" ersetzen, Rest bleibt gleich. Hierzu habe ich ein Makro gefunden, was den Job bis Excel 2003 erledigt. Bei Excel 2013 bleibt er wie erwartet beim Befehl "Application.FileSearch" hängen. 

Da ich absoluter VBA-Neuling bin, würde ich gerne wissen, wie ich das Makro unter Excel 2013 zum Laufen bringe. Bitte seid gnädig mit mir, ich stehe noch ganz am Anfang.

LG

Option Explicit
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32" (lpbi As InfoT) As Long
Private Declare PtrSafe Function CoTaskMemFree Lib "ole32" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpStr1 As String, ByVal lpStr2 As String) As Long
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32" (ByVal pList As Long, ByVal lpBuffer As String) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassname As String, ByVal lpWindowName As String) As Long
Private Type InfoT
    hwnd As Long
    Root As Long
    DisplayName As Long
    Title As Long
    Flags As Long
    FName As Long
    lParam As Long
    Image As Long
End Type
 
Public Sub Dateiliste()
    Dim strLinks
    Dim index As Long
    Dim i As Integer
    Dim strDatei As String
    Dim strAltPfad As String
    Dim strNeuPfad As String
    Dim intZeile As Integer
   
    strAltPfad = Range("B1").Value
    strNeuPfad = Range("B2").Value
    intZeile = 5  'Beginn Ausgabe
   
    Application.ScreenUpdating = False
    With Application.FileSearch
        .LookIn = GetAOrdner
        .FileType = msoFileTypeExcelWorkbooks
        .SearchSubFolders = True
        If .Execute > 0 Then
            'On Error Resume Next
            Application.EnableEvents = False
            For index = 1 To .FoundFiles.Count
                strDatei = .FoundFiles(index)
                intZeile = intZeile + 1
                Cells(intZeile, 1) = strDatei
                Workbooks.Open (strDatei), UpdateLinks:=False
                strLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
                If Not IsEmpty(strLinks) Then
                  For i = LBound(strLinks) To UBound(strLinks)
                    If UCase(Left(strLinks(i), Len(strAltPfad))) = UCase(strAltPfad) Then
                     
                      ActiveWorkbook.ChangeLink Name:=strLinks(i), _
                      NewName:=strNeuPfad & Right(strLinks(i), Len(strLinks(i)) - Len(strAltPfad)), _
                      Type:=xlExcelLinks
                      ThisWorkbook.Sheets(1).Cells(intZeile, 2) = "alte Verknüpfung: " & strLinks(i)
                      intZeile = intZeile + 1
                      ThisWorkbook.Sheets(1).Cells(intZeile, 2) = "neue Verknüpfung: " & strNeuPfad & Right(strLinks(i), Len(strLinks(i)) - Len(strAltPfad))
                      ActiveWorkbook.Save
                    End If
                  Next i
                End If
                ActiveWorkbook.Close savechanges:=False
            Next
        End If
    End With
    Application.ScreenUpdating = True
    Application.EnableEvents = True
   
End Sub
Private Function GetAOrdner() As String
    Dim xl As InfoT, IDList As Long, RVal As Long, FolderName As String
    With xl
        .hwnd = FindWindow("xlmain", vbNullString)
        .Title = lstrcat("Bitte wählen Sie ein Verzeichnis", "")
        .Flags = 1
    End With
    IDList = SHBrowseForFolder(xl)
    If IDList <> 0 Then
        FolderName = Space(256)
        RVal = SHGetPathFromIDList(IDList, FolderName)
        CoTaskMemFree (IDList)
        FolderName = Trim(FolderName)
        FolderName = Left(FolderName, Len(FolderName) - 1)
    End If
    GetAOrdner = FolderName
End Function