PDA

Vollständige Version anzeigen : Verknüpfung auf dem Desktop


Zeljko
03.01.2001, 14:29
Hi,

ich fange gerade an mit VB6 habe bisher intensiv mit Access 2000 gearbeitet und weiß, daß ich mit Access keine benutzerdefinierten Verknüpfungen erstellen kann. Wie könnte ich das unter VB6 realisieren? Oder wo kann ich mich schlau machen?

Thanxx im voraus
Zeljko

Manuela Kulpa
03.01.2001, 16:10
Hallo Zeljko!

Anbei ein Beispiel, mit vielen Grüssen von meinem Mann :). Leider gibt es hierfür keine "saubere" API-Lösung. Daher basiert das Beispiel auf dem Windows Scripting Host!

<font face="Courier New" size="3">Option Explicit

<pre>'Beispielaufruf
Sub Test()

CreateShortcut sShortcutName:=Fld_Desktop & "\Editor.lnk", _
sTargetPath:="J:\WINNT\NOTEPAD.EXE", _
sWorkingDirectory:="J:\WINNT"

End Sub

Public Property Get Fld_Desktop() As Variant

'// ======================================================================
'// WSH 1.0: Windows-Spezialordner ermitteln (Win9x/NT).
'// ======================================================================
On Error GoTo Err_Fld_Desktop

Dim objWshShell As Object
Set objWshShell = CreateObject("WScript.Shell")
If Not objWshShell Is Nothing Then
Fld_Desktop = _
objWshShell.SpecialFolders("Desktop")
End If
Exit Property

Err_Fld_Desktop:
MsgBox Err.Description, Err.Source, _
Err.Number, Err.LastDllError
Exit Property

End Property


Public Function CreateShortcut(ByVal sShortcutName As String, ByVal sTargetPath As String, _
Optional sHotkey As String = vbNullString, _
Optional sIconLocation As String = vbNullString, _
Optional sDescription As String = vbNullString, _
Optional sWorkingDirectory As String = vbNullString, _
Optional lWindowStyle As Long = 1) As Boolean

On Error GoTo Err_CreateShortcut
'// ======================================================================
'// WSH 1.0: Funktion zur Erstellung eines Shortcuts.
'// ======================================================================
'// Parameter:
'// ----------------------------------------------------------------------
'// sShortcutName |kompletter, gültiger Zielpfad (.LNK)
'// sTargetPath |Dateipfad, zu der ein Shortcut erstellt werden soll.
'// sHotkey |möglicher Hotkey; z.B. "ALT+CTRL+F"
'// |modifier: "ALT+" | "CTRL+" | "SHIFT+" | "EXT+"
'// |keyname: "A".."Z" |
'// | "0".."9" |
'// | "Back" | "Tab" | "Clear" | "Return"
'// | "Escape" | "Space" | "Prior" | ...
'// sIconLocation |Pfad, Index des Icons (Bsp.: "notepad.exe, 0");
'// |dieser Pfad kann vom 'sTargetPath' abweichen.
'// lWindowStyle |1: Aktiviert und zeigt ein Fenster an.
'// | Ist das Fenster minimiert oder maxmiert, wird es
'// | in Orginalgröße -und Position wiederhergestellt.
'// |3: Aktiviert und zeigt ein maximiert Fenster an.
'// |7: Minimiert ein Fenster und aktiviert das nächste
'// | Top-level Fenster in der 'Z-Order' an.
'// sDescription |Kurze Beschreibung des Shortcuts.
'// sWorkingDirectory |Ausführen in ... Verzeichnis
'// ======================================================================
'// Hotkeys können nur Shortcuts aktivieren, die im Windows-Desktop oder
'// im Windows Startmenü gespeichert sind.
'// ======================================================================
'// Rückgabe: True, wenn das speichern erfolgreich war
'// False, wenn das speichern nicht erfolgreich war
'// ======================================================================
CreateShortcut = False
'// ======================================================================
'// WshShell-Objekt erstellen
'// ======================================================================
Dim objShellLink As Object
Dim objWshShell As Object
Set objWshShell = CreateObject("WScript.Shell")
'// ======================================================================
'// Parameter überprüfen: Extension von sShortcutName muss .lnk sein!
'// ======================================================================
If VBA.Right$(VBA.LCase$(sShortcutName), 4) <> ".lnk" Then
sShortcutName = sShortcutName & ".lnk"
End If
'// ======================================================================
'// Parameter überprüfen: lWindowStyle muss 1, 3 oder 7 sein
'// ======================================================================
Select Case lWindowStyle
Case 1, 3, 7
Case Else: lWindowStyle = 1
End Select
'// ======================================================================
'// Die Parameter sHotkey, sIconLocation und sDescription werden nicht
'// weiter geprüft.
'// ======================================================================
If Not objWshShell Is Nothing Then
'// ==================================================================
'// Shortcut-Objekt erstellen
'// ==================================================================
Set objShellLink = objWshShell.CreateShortcut(sShortcutName)
If Not objShellLink Is Nothing Then
'// ==============================================================
'// TargetPath setzen
'// ==============================================================
objShellLink.TargetPath = sTargetPath
'// ==============================================================
'// Optional Link-Beschreibung setzen
'// ==============================================================
If VBA.Len(sDescription) > 0 Then _
objShellLink.Description = sDescription
'// ==============================================================
'// Optional Hotkey setzen
'// ==============================================================
If VBA.Len(sHotkey) > 0 Then objShellLink.Hotkey = sHotkey
'// ==============================================================
'// Optional IconLocation setzen
'// ==============================================================
If VBA.Len(sIconLocation) > 0 Then _
objShellLink.IconLocation = sIconLocation
'// ==============================================================
'// Optional das Arbeitsverzeichnis setzen
'// ==============================================================
If Len(sWorkingDirectory) > 0 Then _
objShellLink.WorkingDirectory = sWorkingDirectory
'// ==============================================================
'// WindowStyle setzen
'// ==============================================================
objShellLink.WindowStyle = lWindowStyle
'// ==============================================================
'// Shortcut speichern
'// ==============================================================
objShellLink.Save
CreateShortcut = True
End If
End If
Exit Function

Err_CreateShortcut:
MsgBox Err.Description, Err.Source, _
Err.Number, Err.LastDllError
CreateShortcut = False

End Function</pre></font>

LLAP

Zeljko
03.01.2001, 16:20
Danke Manuela,

ich werde es versuchen. Werte Grüße zurück und auch ein frohes neues an Euch beide. :-)

PS.: Was heißt eigentlich 'LLAP'?

Manuela Kulpa
03.01.2001, 17:07
Vielen Dank Zeljko, werde ich weiterleiten!

LLAP - Live Long And Prosper ;)