Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1132to1136
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Verknüpfung mit Symbol-Bild erstellen

Verknüpfung mit Symbol-Bild erstellen
Dietmar
Hallo zusammen!
Folgenden Code habe ich hier im Forum erhalten ... und ... er funktioniert klasse!
Ist es möglich diesen Code so zu erweitern, dass die Verknüpfung direkt mit einem Symbol dargestellt wird?
Beispielsweise mit dem Schmetterling, den man als OrdnerSymbol verwenden kann:
%SystemRoot%\system32\SHELL32.dll
Händisch lässt sich dies bei Verknüpfungen ja nachholen (Rechtsklick auf die Verknüpfung >Eigenschaften >anderesSymbol).
Somit vermute ich, dass das auch direkt codiert werden kann.
Jemand eine Ahnung wie der nachfolgende Code angepasst werden müsste?
Vielen Dank vorab!
Dietmar aus Aachen
Hier der Code:
Sub DesktopVerknüpfungErstellen()
Dim strDesktop As String
Dim objLink As Object
Dim strFile As String
Dim strPath As String
Dim objWSH As Object
On Error GoTo Fin
strPath = "C:\OrdnerXY\" ' anpassen
strFile = "DateiXY" ' anpassen
If Dir$(strPath & strFile) = "" Then Error 53
Set objWSH = CreateObject("WScript.Shell")
strDesktop = objWSH.SpecialFolders("Desktop")
Set objLink = objWSH.CreateShortcut(strDesktop & "\" & strFile & ".lnk")
With objLink
.Targetpath = strPath & strFile
.Save
End With
MsgBox "Fertig!", vbInformation, "Meldung"
cleanup:
Set objWSH = Nothing
Exit Sub
Fin:
MsgBox "Die Verknüpfung konnte NICHT erstellt werden; Datei nicht vorhanden.", vbCritical, " _
Hinweis"
Resume cleanup
End Sub

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

Betreff
Benutzer
Anzeige
AW: Verknüpfung mit Symbol-Bild erstellen
26.01.2010 21:58:16
Tino
Hallo,
könnte so gehen.
Mit der Nummer hinten bei .IconLocation ... kannst Du das Symbol einstellen.
Sub Beispiel()
Dim oShell As Object, oLink As Object
Dim strDesktop$, strPath$, strFile$, strLinkName$
strPath = "C:\OrdnerXY\" 'Ordner anpassen
strFile = "timer 2.xls"  'Dateiname anpassen
strLinkName = "xxxx.lnk" 'wie soll der link heißen?
If Dir(strPath & strFile)  "" Then
' Verweis auf den Windows Scripting Host erstellen
Set oShell = CreateObject("WScript.Shell")
'Desktoppfad?
strDesktop = oShell.SpecialFolders("Desktop")
strDesktop = IIf(Right$(strDesktop, 1) = "\", strDesktop, strDesktop & "\")
' Neuen Link Erstellen auf strDesktop
Set oLink = oShell.CreateShortcut(strDesktop & strLinkName)
With oLink
.TargetPath = strPath & strFile 'Pfad zur Datei
.IconLocation = "%SystemRoot%\system32\SHELL32.dll, 4" 'Symbol
.Save 'speichern
End With
End If
Set oLink = Nothing
Set oShell = Nothing
End Sub
Gruß Tino
Anzeige
Tino KLASSE! habe was ergänzt, o.k. so?
27.01.2010 15:52:50
Dietmar
Hallo Tino,
hammerstark! Danke.
Habe noch Errormeldung und Erfolgsmeldung reingebastelt. Funktioniert auch.
Schau doch mal bitte drüber, ob ich etwas gravierendes falsch gemacht habe, oder ob es so gut ist.
Herzlichen Dank!
Viele Grüße
Dietmar aus Aachen
Sub BeispielVonDietmarErgaenzt()
Dim oShell As Object, oLink As Object
Dim strDesktop$, strPath$, strFile$, strLinkName$
On Error GoTo Fin   'von Dietmar ergänzt
strPath = "C:\OrdnerXY\" 'Ordner anpassen
strFile = "timer 2.xls"  'Dateiname anpassen
strLinkName = "NameLink.lnk" 'wie soll der link heißen?
If Dir(strPath & strFile) = "" Then Error 53    'On Error-Meldung von Dietmar ergänzt
' Verweis auf den Windows Scripting Host erstellen
Set oShell = CreateObject("WScript.Shell")
'Desktoppfad?
strDesktop = oShell.SpecialFolders("Desktop")
strDesktop = IIf(Right$(strDesktop, 1) = "\", strDesktop, strDesktop & "\")
'Neuen Link Erstellen auf strDesktop
Set oLink = oShell.CreateShortcut(strDesktop & strLinkName)
With oLink
.TargetPath = strPath & strFile 'Pfad zur Datei
.IconLocation = "%SystemRoot%\system32\SHELL32.dll, 43" 'Symbol Schmetterling = 130,  _
Stern = 43
.Save 'speichern
End With
MsgBox "Ja! das hat geklappt!", vbInformation, "Erfolgsmeldung"
'End If     'von Dietmar auskommentiert
cleanup: 'von Dietmar ergänzt
Set oLink = Nothing
Set oShell = Nothing
Exit Sub:   'von Dietmar ergänzt
Fin:    'von Dietmar ergänzt
MsgBox "Nein! hat leider nicht geklappt, die Datei ist nicht vorhanden.", vbCritical, " _
Negativmeldung"  'von Dietmar ergänzt
End Sub

Anzeige
AW: Tino KLASSE! habe was ergänzt, o.k. so?
27.01.2010 16:55:27
Tino
Hallo,
schaut eigentlich gut aus, bis auf die Fehlerbehandlung.
Die würde ich eventuell so machen.
Sub BeispielVonDietmarErgaenzt()

Dim oShell As Object, oLink As Object
Dim strDesktop$, strPath$, strFile$, strLinkName$

On Error GoTo ErrorHandler:  'von Dietmar ergänzt 

    strPath = "C:\OrdnerXY\" 'Ordner anpassen 
    strFile = "timer 2.xls"  'Dateiname anpassen 
    strLinkName = "NameLink.lnk" 'wie soll der link heißen? 

If Dir(strPath & strFile) = "" Then GoTo Fin: 'On Error-Meldung von Dietmar ergänzt 
    
    ' Verweis auf den Windows Scripting Host erstellen 
    Set oShell = CreateObject("WScript.Shell")
    
    'Desktoppfad? 
    strDesktop = oShell.SpecialFolders("Desktop")
    strDesktop = IIf(Right$(strDesktop, 1) = "\", strDesktop, strDesktop & "\")
    
    'Neuen Link Erstellen auf strDesktop 
    Set oLink = oShell.CreateShortcut(strDesktop & strLinkName)
    
    With oLink
        .TargetPath = strPath & strFile 'Pfad zur Datei 
        .IconLocation = "%SystemRoot%\system32\SHELL32.dll, 43" 'Symbol Schmetterling = 130, Stern = 43 
        .Save 'speichern 
    End With
        
    MsgBox "Ja! das hat geklappt!", vbInformation, "Erfolgsmeldung"

Cleanup: 'von Dietmar ergänzt 

Set oLink = Nothing
Set oShell = Nothing
    
Exit Sub   'von Dietmar ergänzt 
    
Fin:    'von Dietmar ergänzt 
MsgBox "Nein! hat leider nicht geklappt, die Datei ist nicht vorhanden.", vbCritical, "Negativmeldung"  'von Dietmar ergänzt 
GoTo Cleanup:

ErrorHandler:
MsgBox "FehlerNummer: " & Err.Number & vbCr & vbCr & Err.Description, vbCritical, "Hat leider nicht geklappt!"
GoTo Cleanup:
End Sub
Gruß Tino
Anzeige
Das mit dem Error-Handler ist wirklich gut!
27.01.2010 17:46:20
Dietmar
Danke Tino,
das ist perfekt! Dass mal eine Symbolnummer nicht vorhanden sein könnte, hatte ich nicht bedacht. Ich hatte vermutet, dass eine Nr. 43 immer vorhanden ist; sollte der Stern mal bei einem Betriebssystem entfertn worden sein, dann dachte ich , dass automatisch ein anderes Symbole auf die Nr. 43 nachrückt. Ist aber wohl nicht so.
Kann ich eigentlich grundsätzlich davon aus gehen, dass die Symbolnummern bei allen Windows-Betriebssystemen identisch sind?
Viele Grüße
Dietmar aus Aachen
ich kann Dir auch nicht sagen...
27.01.2010 17:51:10
Tino
Hallo,
ob die auf allen Systemen gleich sind.
Gruß Tino
... ok, sei's drum die Sache ist Spitze!
27.01.2010 18:16:57
Dietmar
Hallo Tino,
vielen Dank, du hast mir sehr geholfen.
Dietmar aus Aachen
Anzeige

180 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige