Option Explicit
Dim WSH,StartOrdner,FSO,Ordner,Dateien,Datei,DateiPfad,LNK
Set WSH = CreateObject("WScript.Shell")
StartOrdner = "C:\A"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Ordner = FSO.GetFolder(StartOrdner)
Set Dateien = Ordner.Files
For Each Datei in Dateien
DateiPfad = Datei.Path
If Ucase(FSO.GetExtensionName(DateiPfad)) = "LNK" Then
'Call ExtrahiereZielPfad(DateiPfad)
Call ExtrahiereIconPfad(DateiPfad)
End If
Next
WScript.Quit
'Sub ExtrahiereZielPfad(LNKDAT)
' set WSH = CreateObject("WScript.Shell")
' set LNK = WSH.Createshortcut(LNKDAT)
' WScript.Echo "Link="& DoppelAnfZ(LNK) & vbcrlf & "Target="& DoppelAnfZ(LNK.TargetPath)
'End Sub
Sub ExtrahiereIconPfad(LNKDAT)
Dim LinkPfad,LinkPfadNeu
set WSH = CreateObject("WScript.Shell")
set LNK = WSH.Createshortcut(LNKDAT)
LinkPfad = LNK.IconLocation
'WScript.Echo "Link="& DoppelAnfZ(LNK) & vbcrlf & "Icon="& DoppelAnfZ(LNK.IconLocation)
If InStr(LinkPfad, "I:\") > 0 then
'WScript.Echo "Link="& DoppelAnfZ(LNK) & vbcrlf & "Icon="& LinkPfad
LinkPfadNeu = "E" & mid(LinkPfad, 2)
LNK.IconLocation = LinkPfadNeu
LNK.Save
End If
End Sub
Function DoppelAnfZ(Inhalt)
DoppelAnfZ = Chr(34) & Inhalt & Chr(34)
End FunctionOption Explicit