VBA Tipp: Verknüpfung auf dem Desktop anlegen

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

  • Aufgabe 1: Ich möchte eine Verknüpfung auf dem Desktop per Programm anlegen, oder die Eigenschaften einer bestehenden Verknüpfung ändern.
  • Aufgabe 2: Ich möchte eine Verknüpfung auf dem Desktop löschen.

Lösung Aufgabe 1

Vorausgesetzt, der Windows Scripting Host ist auf dem Zielrechner installiert, geht das mit folgender Prozedur, die in einem globalen Modul hinterlegt wird:

Public Sub DesktopsymbolErzeugen(LinkName As String, _
                                 ByVal ProgrammPfad As String, _
                                 ByVal VerzeichnisPfad As String, _
                                 Optional Parameter As String, _
                                 Optional IconPfad As String, _
                                 Optional Beschreibung As String)
 
   'Erzeugt ein neues Desktopsymbol oder ändert die Eigenschaften eines bestehenden Desktopsymbols
   'Ein bestehender Linkname kann nicht geändert, sondern nur ein neuer Link angelegt werden.
   'Late-Binding-Variante, kein Verweis auf "Windows Script Host Object Model" notwendig
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Dim wsh           As Object   'Shell Objekt
   Dim desktopSymbol As Object   'Shortcut Objekt
   Dim desktopPfad   As String
 
   ' Objektvariable mit Windows.Scripting-Host erstellen
   Set wsh = CreateObject("WScript.Shell")
 
   ' Desktoppfad auslesen
   desktopPfad = wsh.SpecialFolders("Desktop")
 
   ' Neue oder bestehende Verknüpfung in Objektvariable einlesen
   Set desktopSymbol = wsh.CreateShortcut(desktopPfad & "\" & LinkName & ".lnk")
 
   ' "Ziel" eintragen
   desktopSymbol.TargetPath = ProgrammPfad
 
   ' Beispiele für Parameter
   ' Parameter = "/wrkgrp " & Chr(34) & PfadZurArbeitsgruppendatei & Chr(34) & Chr(32)
   ' Parameter = "/excl" & Chr(32) 'Datenbank exclusiv öffnen
 
   ' Parameter eintragen
   desktopSymbol.Arguments = Parameter
 
   ' "Ausführen in" eintragen
   desktopSymbol.WorkingDirectory = VerzeichnisPfad
 
   '**********************************************************
   ' Weitere mögliche Einträge
 
   ' "Tastenkombination" (Beispiele: CTRL+W, "CTRL+SHIFT+F8")
   ' desktopSymbol.Hotkey = "CTRL+W"
 
   ' "Ausführen", (4 = Normal, 3 = Maximized, 7 = Minimized)
   ' desktopSymbol.WindowStyle = 3
   '**********************************************************
 
   ' "Kommentar" eintragen
   desktopSymbol.Description = Beschreibung
 
   ' Eigenes Icon zuweisen
   If Len(IconPfad) > 0 Then
      desktopSymbol.IconLocation = IconPfad
   End If
 
   ' Element speichern
   desktopSymbol.Save
 
End Sub

Aufruf

   Dim iconpfad As String
 
   'Beispiel: Icon-Datei "favicon.ico" im Unterverzeichnis "Bilder"
   iconpfad = CurrentProject.Path & "\Bilder\favicon.ico"
 
   ' Beispiel 1: Desktopsymbol für die aktuelle Access-Datenbank erzeugen, mit eigenem Icon, ohne Parameter
   Call DesktopsymbolErzeugen("Testverknüpfung", CurrentDb.Name, CurrentProject.Path, , iconpfad)
 
   'Beispiel 2: Desktopsymbol für die aktuelle Access-Datenbank erzeugen, ohne eigenes Icon, ohne Parameter
   Call DesktopsymbolErzeugen("Testverknüpfung", CurrentDb.Name, CurrentProject.Path)

Lösung Aufgabe 2

Das geht mit folgender Prozedur, die in einem globalen Modul hinterlegt wird:

Public Sub DesktopSymbolLoeschen(LinkName As String)
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Dim desktoppfad As String
   Dim dateipfad   As String
 
   ' Desktoppfad auslesen
   desktoppfad = CreateObject("WScript.Shell").SpecialFolders("Desktop")
 
   'Dateipfad auslesen
   dateipfad = desktoppfad & "\" & LinkName & ".lnk"
 
   'Datei löschen, wenn sie existiert
   On Error Resume Next
   CreateObject("Scripting.FileSystemObject").DeleteFile dateipfad
 
End Sub

Aufruf

   Call DesktopsymbolLoeschen("Testverknüpfung")

Hinweis:

Wenn die Verknüpfung auf dem Desktop gelöscht, und sofort unter dem gleichen Namen wieder angelegt werden soll, muß zwischen beiden Codes eine Wartezeit von 1 Sekunde eingebaut werden, da es nach der Löschung knapp 1 Sekunde dauert, bis der Windows-Desktop aktualisiert wird.


Wikilinks

Weblinks