AW: Verknüpfung auf dem Desktop
Reinhard
Hi Jochen,
Code aus dem Internet geholt, ist für Access geschrieben, deshalb ist "getpath" unbekannt, müßte aber ansonsten leicht umzustricken sein.
Leider habe ich jetzt keine Zeit dazu, aber vielleicht ein anderer, deshalb frage wieder auf noch offen gestellt.
Gruß
Reinhard
Sub crShortCut()
'Erzeugt oder aktualisiert den Link zu dieser Anwendung via Scripting -Host
Const LNK_FILE = "Meine Anwendung.LNK"
Dim WSHShell, fs
Dim shortCut, DesktopPath, Dateien, Datei
Dim actualMdb As String
Dim lLinkExist As Boolean
Set WSHShell = CreateObject("WScript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")
DesktopPath = WSHShell.SpecialFolders("Desktop")
actualMdb = CurrentDb.Name
'Auf vorhandenen Link prüfen, nach Abfrage aktualisieren
Set Dateien = fs.GetFolder(DesktopPath).Files
For Each Datei In Dateien
If Datei.Name = LNK_FILE Then
lLinkExist = True
Set shortCut = WSHShell.CreateShortcut(DesktopPath & "\" & LNK_FILE)
If shortCut.targetpath <> actualMdb Then
If MsgBox("Desktop - Verknüpfung aktualisieren?", _
vbYesNo, "Neue Programmversion") = vbYes Then
shortCut.targetpath = actualMdb
shortCut.Save
End If
End If
Exit For
End If
Next Datei
'Noch kein Link auf dem Desktop, nach Abfrage anlegen
If Not lLinkExist Then
If MsgBox("Desktop - Verknüpfung erzeugen?", vbYesNo, "Neue Programmversion ") = vbYes Then
Set shortCut = WSHShell.CreateShortcut(DesktopPath & "\" & LNK_FILE)
shortCut.targetpath = actualMdb
shortCut.WorkingDirectory = getpath(actualMdb)
shortCut.WindowStyle = 4
shortCut.IconLocation = getpath(actualMdb) & "\MeinIcon.ico"
shortCut.Save
End If
End If
End Sub