Bitte um Ideen für ein Script zum Bereinigen von Verknüpfungen

Hintergrund:
In unserem Unternehmen wurden einige Fileserver umgezogen. Technisch gesehen, befinden sich nun alle Dateien auf einem anderen Server. Somit würden die Verknüpfungen die auf diese Dateien verweisen nicht mehr funktionieren. Da wir dies vermeiden wollen, haben wir das Problem vorläufig mit einer "Umleitung" behoben.

Diese Lösung soll aber nur für den Übergang sein. Deshalb habe ich ein Script geschrieben, welches alle Verknüpfungen in einem angegebenen Ordner und deren Unterordner bereinigen soll. Hierfür werden die zu ändernden Zielpfade und die neuen Pfade aus einer Textdatei ausgelesen. In der Textdatei sind alle Ordner der ersten Ebene enthalten. (Siehe Beispiel)

Dies soll nur ein Beispiel zur Veranschaulichung sein. Letztendlich soll der Zielpfad einer Verknüpfung angepasst werden, sofern dieser einen String der linken Spalte enthält. Wenn dem so ist, wird der Zielpfad der rechten Spalte verwendet.

Problem:
Das Script ist fertig gestellt und funktioniert.
Leider ist es nur so, dass in vielen Verknüpfungen (ca. 80%) der Laufwerksbuchstabe enthalten ist und nicht der vollständige Serverpfad.

Beispiel:
Statt \\altserver1\Ordner1\Mustermann\Doku.doc
S:\Mustermann\Doku.doc
Somit wird diese Verknüpfung in meinem Script nicht berücksichtigt.

Lösungsversuch:
Mit dem Notepad++ kann man die lnk-Datei auslesen. Dort steht der vollständige Serverpfad auch drin. (Siehe Anhang) Wenn ich die Möglichkeit hätte die lnk Dateien mit vbs auszulesen, wäre das Problem gelöst. Doch leider ist mir dies nicht möglich. Ich bekomme immer nur "L" zurück. (Siehe Quellcode)




Für Ideen bin ich sehr dankbar.

Viele Grüße
Caradh

Set objShell= WScript.CreateObject("Wscript.Shell")  
Set objShortcut = objShell.CreateShortcut("C:\Test\Test.doc.lnk")  
WScript.Echo objShortcut.TargetPath

saveBinaryFileToString()

Private Sub saveBinaryFileToString()

    Dim byteArray

    byteArray = ReadByteArray("C:\Doku.doc.lnk")  
    SaveBinaryDataTextStream "String.txt", byteArray  

End Sub

Function ReadByteArray(strFileName)
    Const adTypeBinary = 1
    Dim bin
    Set bin = CreateObject("ADODB.Stream")  
    bin.Type = adTypeBinary
    bin.Open
    bin.LoadFromFile strFileName
    ReadByteArray = bin.Read
End Function

Sub SaveBinaryDataTextStream(FileName, ByteArray)
  'Create FileSystemObject object  
  Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")  
  
  'Create text stream object  
  Dim TextStream
  Set TextStream = FS.CreateTextFile(FileName)
  
  'Convert binary data To text And write them To the file  
  TextStream.Write BinaryToString(ByteArray)
End Sub

Function BinaryToString(Binary)
  'Antonin Foller, http://www.motobit.com  
  'Optimized version of a simple BinaryToString algorithm.  
  
  Dim cl1, cl2, cl3, pl1, pl2, pl3
  Dim L
  cl1 = 1
  cl2 = 1
  cl3 = 1
  L = LenB(Binary)
  
  Do While cl1<=L
    pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1)))
    cl1 = cl1 + 1
    cl3 = cl3 + 1
    If cl3>300 Then
      pl2 = pl2 & pl3
      pl3 = ""  
      cl3 = 1
      cl2 = cl2 + 1
      If cl2>200 Then
        pl1 = pl1 & pl2
        pl2 = ""  
        cl2 = 1
      End If
    End If
  Loop
  BinaryToString = pl1 & pl2 & pl3
End Function