Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1032to1036
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

Prüfe ob Desktopverknüpfung vorhanden........

Prüfe ob Desktopverknüpfung vorhanden........
13.12.2008 17:44:00
Sonnenpeter
Hallo,
den nachfolgenden Makrocode habe ich aus der Recherche. Funktioniert einwandfrei.

Sub VerkuepfungAnlegen()
Dim wbA As Workbook
Dim wSh As Object
Dim oSh As Object
Dim sDesktop As String
Set wbA = ActiveWorkbook
If wbA.Name = wbA.FullName Then
MsgBox wbA.Name & " muss erst gespeichert werden!"
Exit Sub
End If
Set wSh = CreateObject("WScript.Shell")
sDesktop = wSh.SpecialFolders("Desktop")
Set oSh = wSh.CreateShortcut(sDesktop & "\" & "Stillstands- und Schadensmeldungen.lnk")
'Set oSh = wSh.CreateShortcut(sDesktop & "\" & wbA.Name & ".lnk")
With oSh
.targetpath = wbA.FullName
.Save
End With
Set wSh = Nothing
MsgBox "Desktop-Verknüpfung wurde erstellt", vbExclamation, "Desktop-Verknüpfung"
End Sub


Wie stelle ich es an, dass zunächst geprüft wird ob die Verknüpfung schon vorhanden ist?
Gibt es die Möglichkeit ein vorher ausgewähltes Ikon anstatt der sonst standardisierten Excel- Icons zu hinterlegen?
Gruß Sonnenpeter

19
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Prüfe ob Desktopverknüpfung vorhanden........
13.12.2008 17:59:00
ransi
HAllo Peter
Auf die Schnelle zusammngeschustert:
Option Explicit


Public Sub Verknuepfungen_auslesen()
Dim Sh
Dim ordner
Dim Datei
Dim MyWSH
Dim MyDesktop
Set MyWSH = CreateObject("Wscript.Shell")
Set Sh = CreateObject("Shell.application")
MyDesktop = MyWSH.specialfolders("Desktop")
Set ordner = Sh.NameSpace(MyDesktop)
For Each Datei In ordner.items
    If Datei.IsLink Then
        With Datei.GetLink
            Debug.Print _
                .Path & vbCrLf & _
                .Target.Path & vbCrLf & _
                .Description & vbCrLf
        End With
    End If
Next
End Sub


Mit den Icons muss ich nochmal drüber schlafen.
ransi
Anzeige
AW: Prüfe ob Desktopverknüpfung vorhanden........
13.12.2008 18:31:27
ransi
HAllo Peter
War wohl etwas umständlich...
Einfacher gehts so:
sDesktop = wSh.SpecialFolders("Desktop")
If Dir(sDesktop & "\" & "Stillstands- und Schadensmeldungen.lnk") <> "" Then
    MsgBox "Es gibt eine Verknüpfung mit dem passenden Dateinamen"
End If
Set oSh = wSh.CreateShortcut(sDesktop & "\" & "Stillstands- und Schadensmeldungen.lnk")

Allerdings sagt das nichts darüber aus wohin der Link geht.
Das müsstest du wieder prüfen.
ransi
Anzeige
Super.........
13.12.2008 19:22:00
Sonnenpeter
Servus Ransi,
Danke für die Unterstützung, nachfolgend das funktionierende Makro :-)))

Sub VerkuepfungPruefenWennNeinVerknuepfungAnlegen()
Dim wbA As Workbook
Dim wSh As Object
Dim oSh As Object
Dim sDesktop As String
Set wbA = ActiveWorkbook
If wbA.Name = wbA.FullName Then
MsgBox wbA.Name & " muss erst gespeichert werden!"
Exit Sub
End If
Set wSh = CreateObject("WScript.Shell")
sDesktop = wSh.SpecialFolders("Desktop")
Set oSh = wSh.CreateShortcut(sDesktop & "\" & "Stillstands- und Schadensmeldungen.lnk")
sDesktop = wSh.SpecialFolders("Desktop")
If Dir(sDesktop & "\" & "Stillstands- und Schadensmeldungen.lnk")  "" Then
MsgBox "Es gibt eine Verknüpfung mit dem passenden Dateinamen"
Exit Sub
End If
Set oSh = wSh.CreateShortcut(sDesktop & "\" & "Stillstands- und Schadensmeldungen.lnk")
With oSh
.targetpath = wbA.FullName
.Save
End With
Set wSh = Nothing
MsgBox "Desktop-Verknüpfung wurde erstellt", vbExclamation, "Desktop-Verknüpfung"
End Sub


Gruß Sonnenpeter

Anzeige
Der Dateiname alleine hilft dir nicht...
13.12.2008 19:50:03
ransi
...weiter.
Der Link kann sonstwohin gehen.
Damit das Ganze Sinn macht musst du mit
.GetLink.Path
noch das Ziel prüfen.
Du kannst die Prüfung aber auch komplett weglassen.
CreateShortCut überschreibt einen schon vorhandenen Link.
Somit bist du immer im sicheren Bereich.
ransi
Desktopverknüpfung erstellen
13.12.2008 19:01:58
Reinhard
Hi Peter,
man muß da noch einen Verweis auf eine shelllnk.tbl setzen, die gibt es beim u.a. Link zum Runterladen.
Wenn der Verweis gesetzt ist, läuft der Code durch, macht aber irgendwie nix, es wird leine Datei erstellt.
Das gleiche Nichtgeschehen geschieht mit VB5.0, also kann ja hier vielleicht jemand mit vba-Wissen den Code zum laufen bringen.
Bei Ransis Code kann man beim Debug.print noch einbauen:
.GetIconLocation(0)
aber irgendwie die Syntax von GetIconLocation als Gegenbefehl zu
.SetIconLocation IconPath, IconNumber
brachte ich nicht zusammen um das benutze Icon zu erfahren.
.getIconlocation.NumberPath klappt natürlich nicht.

Option Explicit
Sub tt()
CreateLink "c:\winnt\notepad.exe", "c:\Test.lnk", _
, , "C:\Dokumente und Einstellungen\IchalsAdministrator\Desktop", _
"C:\WINNT\system32\moricons.dll", 22
End Sub
Public Sub CreateLink(ByVal Datei As String, _
ByVal LinkName As String, _
Optional ByVal Parameter As String = "", _
Optional ByVal Comment As String = "", _
Optional ByVal WorkingDir As String = "", _
Optional ByVal IconPath As String = "", _
Optional ByVal IconNumber As Long = 0)
Dim cShellLink As ShellLinkA
Dim cPersistFile As IPersistFile
Set cShellLink = New ShellLinkA
Set cPersistFile = cShellLink
With cShellLink
' Pfad+Dateiname der Anwendung
.SetPath Datei
' Parameter
If Parameter  "" Then _
.SetArguments Parameter
' Kommentar
If Comment  "" Then _
.SetDescription Comment
' Arbeitsverzeichnis (Ausführen in)
If WorkingDir  "" Then _
.SetWorkingDirectory WorkingDir
' Icon definieren
If IconPath  "" And IconNumber > 0 Then _
.SetIconLocation IconPath, IconNumber
End With
' Verknüpfung erstellen
cPersistFile.Save StrConv(LinkName, _
vbUnicode), 0
Set cPersistFile = Nothing
Set cShellLink = Nothing
End Sub


Quelle:
http://www.vbarchiv.net/tipps/details.php?id=324
Gruß
Reinhard

Anzeige
AW: Desktopverknüpfung erstellen
13.12.2008 19:37:00
Sonnenpeter
Hallo Reinhard,
ich habe mir die Quelle: http://www.vbarchiv.net/tipps/details.php?id=324 angesehen und ein Lesezeichen gesetzt.
Interessante Seite werde ich sicher mal durchstöbern :-))
Leider übersteigt das Ganze meine Kenntnisse gewaltig, da muss ich noch einiges lernen :-).
Danke für Deine Unterstützung.
Gruß Sonnenpeter
AW: Desktopverknüpfung erstellen
13.12.2008 20:46:23
Reinhard
Hallo Peter,
so klappt es

Sub tt()
Dim MyWSH, MyDesktop
Set MyWSH = CreateObject("Wscript.Shell")
MyDesktop = MyWSH.specialfolders("Desktop")
CreateLink "c:\winnt\notepad.exe", MyDesktop & "\text2.lnk", _
, , , _
"C:\WINNT\system32\moricons.dll", 22
End Sub
Und mit diesen parametern kriegste das doch hin das anzupassen:
Parameterbeschreibung:
Datei	Pfad+Dateiname der Anwendung, welche über die Verknüpfung ausgeführt werden soll
Link	Name und Ort der Verknüpfungsdatei (.lnk)
Parameter	Optional. Parameter für den Aufruf der Anwendung
Comment	Optional. Kommentar (wird im Eigenschaften-Dialog der Verknüpfung angezeigt)
WorkingDir   	Optional. Pfad, in welchem die Anwendung ausgeführt werden soll ( _
Arbeitsverzeichnis)
IconPath   	Optional. Pfad zur Datei, aus der das gewünschte Symbol verwendet werden soll
IconNumber   	Optional. Nummer des Icons aus der in IconPath angegebenen Datei


Gruß
Reinhard

Anzeige
Erstellen
13.12.2008 21:23:00
Tino
Hallo,
hier eine Version zum erstellen.
Modul Modul1
Option Explicit 
 
Sub Desktop_Ink() 
Dim objF As Object, objLink As Object 
Dim strDesktop As String 
Dim NameInk As String, strDatei As String 
 
NameInk = "Meine Verknüpfung.lnk" 'Name der Verknüpfung 
strDatei = "C:\Test\TestFile.xls" 'Pfad der Datei 
 
Set objF = CreateObject("WScript.Shell") 
strDesktop = objF.SpecialFolders("Desktop") 
Set objLink = objF.CreateShortcut(strDesktop & "\" & NameInk) 
 
With objLink 
    .WindowStyle = 1 
    .IconLocation = "C:\Programme\Microsoft Office\OFFICE11\EXCEL.EXE,1" 
    .TargetPath = strDatei 
    .Save 
End With 
 
End Sub 
 


Gruß Tino

Anzeige
AW: Erstellen
14.12.2008 00:51:05
So
.IconLocation = Application.Path & "\EXCEL.EXE,1"
und wer ist der unbekannte helfer? oT.
14.12.2008 10:18:00
Tino
AW: Erstellen
14.12.2008 14:27:00
Sonnenpeter
Aber Hallo, es geht ja irgendwie fast immer was :-)
.IconLocation = Application.Path & "\EXCEL.EXE,1" wirft in der Tat Icons aus "\EXCEL.EXE,2" "\EXCEL.EXE,3"
zeigt dann unterschiedliche Icons. Wenn ich richtig liege sind in der EXCEL.EXE 24 Icons hinterlegt. Zumindest eine kleine Auswahl :-))
Ist das auch mit der "%SystemRoot%\system32\SHELL32.dll" möglich? wenn ja wie?
Gruß Sonnenpeter
AW: Erstellen
14.12.2008 14:49:00
Tino
Hallo,
habe hierzu mal einen primitiven Versuch gemacht.
Auf dem Desktop habe ich mir zu testzwecken einen Ordner erstellt (Neuer Ordner Test)
Option Explicit
 
Sub Desktop_Ink()
Dim objF As Object, objLink As Object
Dim strDesktop As String
Dim NameInk As String, strDatei As String
Dim a As Long

strDatei = "C.\MeineDatei\Test.xls" 'Pfad der Datei 
 
Set objF = CreateObject("WScript.Shell")
strDesktop = objF.SpecialFolders("Desktop")

For a = 1 To 20

NameInk = "Meine Verknüpfung " & a & ".lnk" 'Name der Verknüpfung 

Set objLink = objF.CreateShortcut(strDesktop & "\Neuer Ordner Test\" & NameInk)

    With objLink
        .WindowStyle = 1
        .IconLocation = "%SystemRoot%\system32\SHELL32.dll," & a
        .TargetPath = strDatei
        .Save
    End With
Next a
End Sub


Gruß Tino

Anzeige
AW: Erstellen
14.12.2008 14:50:00
Sonnenpeter
Hallo nochmal,
ich bin ein Stückschen weiter
With objLink
.WindowStyle = 1
.IconLocation = "%SystemRoot%\system32\SHELL32.dll, 56"
.TargetPath = strDatei
.Save
End With
funnzt :-)
Nun geht es nur noch darum ein SHELL-Icons zu bestimmen ohne x-fache Versuche bis ich das ausgesuchte Icon habe. Sind die Shell- Ikons auslesbar?
Gruß Sonnenpeter
Icons aus Dateien anzeigen lassen
14.12.2008 16:30:00
Reinhard
Hi Peter,
google mal nach Iconview,
dann stößt u.a. du auf das da:
http://www.freeware-archiv.de/IconView-Icon.htm
Gruß
Reinhard
Anzeige
AW: Icons aus Dateien anzeigen lassen
14.12.2008 18:47:33
Sonnenpeter
Hallo Reinhard,
Danke, ich möchte die Ikons jedoch gerne in einer Exceltabelle darstellen.
War den Nachmittag auf der Suche, noch nix brauchbares dabei raus gekommen :-)
Mal Sehen was sich noch tut.
Gruß Sonnenpeter
AW: Icons aus Dateien anzeigen lassen
14.12.2008 20:24:00
Sonnenpeter
Hallo nochmal,
jetzt habe ich was gefunden.
http://www.glennslayden.com/shell32_icons.htm
Nur die Nummern stimmen nicht, habt ihr was besseres?
Gruß Sonnenpeter
AW: Icons aus Dateien anzeigen lassen
14.12.2008 22:13:33
Original
Hi,
der Index beginnt bei 0, du musst also nur 1 subtrahieren.
Zudem hat diese DLL nur 238 Icons, zumindest unter Windows XP.
mfg Kurt
Anzeige
AW: Icons aus Dateien anzeigen lassen
15.12.2008 09:40:55
Tino
Hallo,
geht es Dir nur um eine Grafig, verwende doch einfach diesen Code und machen von dem Ordner einen Scrinshott.
Option Explicit

 
Sub Desktop_Ink()
Dim objF As Object, objLink As Object
Dim strDesktop As String
Dim NameInk As String, strDatei As String
Dim a As Long

strDatei = "C.\MeineDatei\Test.xls" 'Pfad der Datei 
 
Set objF = CreateObject("WScript.Shell")
strDesktop = objF.SpecialFolders("Desktop")
On Error Resume Next
For a = 0 To 300

NameInk = a & ".lnk"  'Name der Verknüpfung 

Set objLink = objF.CreateShortcut(strDesktop & "\Neuer Ordner Test\" & NameInk)

    With objLink
        .WindowStyle = 1
        .IconLocation = "%SystemRoot%\system32\SHELL32.dll," & a
        .TargetPath = strDatei
        .Save
    End With
Next a
End Sub


Userbild
Gruß Tino

AW: Icons aus Dateien anzeigen lassen
15.12.2008 19:37:00
Sonnenpeter
Hallo Tino,
nochmals Danke.
Ich habe mir zwischenzeitlich IconsExtract v1.45 von Nir Sofer Web Site: http://www.nirsoft.net runtergeladen.
Werde mich aber trotzdem um eine eigene Lösung bemühen.
Gruß Sonnenpeter

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige