Verknüpfung erstellen - keine Wiederholung
Dietmar
den nachfolgenden Code habe ich hier im Forum erhalten, funzt tiptop.
Ich habe die Ausführung im Rahmen von Workbook_Open über Application.Run "VerknüpfungAufDesktop" eingebaut. Damit habe ich gewährleistet, dass die Verknüpfung bei der ersten Öffnung der Datei auch erstellt wird.
Wie kann ich nun erreichen, dass
- entweder der Code beim Öffnen der Datei nicht mehr ausgeführt wird, wenn die Verknüpfung VORHANDEN ist (also durch den Anwender nicht aus Versehen gelöscht wurde), ODER
- zumindest die msgbox-Erfolgsmeldung nicht mehr erscheint (diese muss in jedem Fall beim ersten Öffnen der Datei erscheinen, damit meine Leute wissen, dass sie erstellt wurde).
Jemand eine Idee?
Vielen Dank vorab!
Viele Grüße
Dietmar aus Aachen
Sub VerknüpfungAufDesktop()
Dim oShell As Object, oLink As Object
Dim strDesktop$, strPath$, strFile$, strLinkName$
On Error GoTo ErrorHandler:
strPath = "C:\MLC2010\"
strFile = "MLC2010_Programm.xls"
strLinkName = "MLC2010.lnk"
If Dir(strPath & strFile) = "" Then GoTo Fin:
Set oShell = CreateObject("WScript.Shell")
strDesktop = oShell.SpecialFolders("Desktop")
strDesktop = IIf(Right$(strDesktop, 1) = "\", strDesktop, strDesktop & "\")
Set oLink = oShell.CreateShortcut(strDesktop & strLinkName)
With oLink
.TargetPath = strPath & strFile
.IconLocation = "%SystemRoot%\system32\SHELL32.dll, 159" ' 130=Schmetterling
.Save
End With
MsgBox "OK, die Verknüpfung wurde erstellt"
Cleanup:
Set oLink = Nothing
Set oShell = Nothing
Exit Sub
Fin:
MsgBox "Nein"
GoTo Cleanup:
ErrorHandler:
MsgBox "FehlerNummer: " & Err.Number & vbCr & vbCr & Err.Description, vbCritical, "Hat leider _
nicht geklappt!"
GoTo Cleanup:
End Sub