Ich möchte für einen speziellen Ordner eine Verknüpfung auf dem Desktop erzeugen. Mit folgendem Code, den ich hier vor längerer Zeit bekommen habe geht das wunderbar, wenn es sich um eine DATEI handelt.
Wie erreiche ich, dass die Verlinkung für einen ORDNER erzeugt wird? Sagen wir der Ordner heisst *Test* und liegt unmittelbar auf *C:*
Hier der Code für eine Datei:
Sub VerknüpfungErstellen()
Dim oShell As Object, oLink As Object
Dim strDesktop$, strPath$, strFile$, strLinkName$
On Error GoTo ErrorHandler:
strPath = "C:\Test\"
strFile = "Test_Programm.xls"
strLinkName = "Test-Link.lnk"
If Dir(strPath & strFile) = "" Then GoTo Fin:
Set oShell = CreateObject("WScript.Shell")
strDesktop = oShell.SpecialFolders("Desktop")
strDesktop = IIf(Right$(strDesktop, 1) = "\", strDesktop, strDesktop & "\")
If Dir(strDesktop & strLinkName) "" Then 'also wenn Link existiert
MsgBox "Der Link zum Schnellstart von MLC existiert schon auf Ihrem Desktop" _
& vbCrLf & "Es handelt sich um ein GRÜNER KREIS MIT WEISSEM DREIECK" _
& vbCrLf & vbCrLf & "Gruss" _
& vbCrLf & "Dietmar" _
& vbCrLf & "Ihr Admin :-)", vbOKOnly + vbInformation, "Hinweisfenster"
GoTo Cleanup
End If
Set oLink = oShell.CreateShortcut(strDesktop & strLinkName)
With oLink
.TargetPath = strPath & strFile
.IconLocation = "%SystemRoot%\system32\SHELL32.dll, 137" ' 130 Schmetterling, 137 Grü _
nerKreisMitDreieck
.Save
End With
MsgBox "Die Verknüpfung auf dem Desktop wurde erstellt"
Cleanup:
Set oLink = Nothing
Set oShell = Nothing
Exit Sub
Fin:
MsgBox "Die Verknüpfung konnte leider NICHT erstellt werden." _
& vbCrLf & vbCrLf & "Fehler-Nr. " & Err.Number & vbLf & _
Err.Description _
& vbCrLf & vbCrLf & "Gruss" _
& vbCrLf & "Dietmar", vbCritical, "Fehlermeldung"
GoTo Cleanup:
ErrorHandler:
MsgBox "FehlerNummer: " & Err.Number & vbCr & vbCr & Err.Description, vbCritical, "Leider Nein"
GoTo Cleanup:
End Sub
Vielen Dank vorab!Dietmar aus Aachen