Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
912to916
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
912to916
912to916
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Shortcut auf Desktop

Shortcut auf Desktop
10.10.2007 10:37:08
Walburga
Guten Morgen
ich habe folgendes Makro gefunden:

Sub CreateShortcut()
Dim objShell As Object
Dim objFolder As Object
Dim objFItem As Object
Dim objScriptHost As Object
Dim objShortcut As Object
Dim strShortcutPath As String
Dim strShortcutName As String
Dim strXLFilename As String
On Error Resume Next
Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder _
(0, "Wo soll die Verknuepfung erstellt werden?", 0)
If objFolder Is Nothing Then Exit Sub
On Error GoTo CrSh_Error
Set objFItem = objFolder.Self
strShortcutPath = objFItem.Path
If ActiveWorkbook.Path  "" Then
Set objScriptHost = CreateObject("Wscript.Shell")
strXLFilename = ActiveWorkbook.Name
strShortcutName = _
Left(strXLFilename, _
InStr(1, strXLFilename, ".xl"))
Set objShortcut = _
objScriptHost.CreateShortcut _
(strShortcutPath & "\" & _
strShortcutName & ".lnk")
With objShortcut
.TargetPath = ActiveWorkbook.FullName
.Save
End With
MsgBox "Verknuepfung wurde erstellt."
Else
MsgBox "Sie muessen die Arbeitsmappe erst speichern." & _
vbCr & "Aktion wird abgebrochen..."
End If
CrSh_End:
Set objShortcut = Nothing
Set objFItem = Nothing
Set objFolder = Nothing
Set objShell = Nothing
Set objScriptHost = Nothing
Exit Sub
CrSh_Error:
MsgBox "Fehler beim Erstellen der Verknuepfung"
Err.Clear
Resume CrSh_End
End Sub


Das Makro erstellt für eine Excel-Datei einen ShortCut, leider zeigt es aber auch eine Auswahlliste zum Speichern des Shortcuts an. Ich möchte jedoch den Shortcut nur auf dem "Desktop" angezeigt bekommen, also fest vorgegeben! Was ist zu ändern? Wer hat einen Tipp?
Schönen Tag noch
Walburga

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Shortcut auf Desktop
10.10.2007 11:08:00
Thorsten
Hallo
Theoretisch musst du den spiecherort nur direkt angeben.
die Auswahl des speicherorts kannst du mit einem ' auskommentieren,
und in strShortcutPath = "C:\Documents and Settings\name\Desktop\"
gibst du dein Verzeichniss direkt an.
Ich habs nicht getestet, aber strShortcutPath klingt nach dem Verzeichnisnamen.

AW: Shortcut auf Desktop
10.10.2007 11:36:36
Walburga
Hi Thorsten,

und in strShortcutPath = "C:\Documents and Settings\name\Desktop\" 

ist die Wurzel allen Übels, da dieser String auf jedem Rechner ja verschieden sein kann.
Mein Wunsch ist, diesen Pfad automatisch ermitteln zu lassen.
Lieben Gruss Walburga

Anzeige
AW: Shortcut auf Desktop
10.10.2007 11:48:04
Case
Hallo,
probier mal:

Option Explicit
Public Sub Knopf()
'Unter Extras Verweise... Haken bei "Microsoft Shell Controls And Automation" setzen
Dim strPfad As String
strPfad = Environ("userprofile") & "\Desktop\"
CreateShortcut strPfad & ThisWorkbook.Name & ".lnk", ThisWorkbook.Path & "\" & ThisWorkbook. _
Name
End Sub
Public Function CreateShortcut(ByVal sLinkFile As String, _
ByVal sTargetFile As String, _
Optional ByVal sArguments As String, _
Optional ByVal sDescription As String, _
Optional ByVal sWorkingDir As String)
Dim oShell As New Shell32.Shell
Dim oFolder As Shell32.Folder
Dim oLink As Shell32.ShellLinkObject
Dim sPath As String
Dim sFile As String
Dim F As Integer
' Ordner und Dateiname extrahieren
sPath = Left$(sLinkFile, InStrRev(sLinkFile, "\") - 1)
sFile = Mid$(sLinkFile, InStrRev(sLinkFile, "\") + 1)
' Link-Datei mit 0 Bytes erstellen, da die
' LNK-Datei bereits voranden sein muss!
F = FreeFile
Open sLinkFile For Output As #F: Close #F
Set oFolder = oShell.Namespace(sPath)
Set oLink = oFolder.Items.Item(sFile).GetLink
' Eigenschaften der Verknüpfung
With oLink
If sArguments  "" Then .Arguments = sArguments
If sDescription  "" Then .Description = sDescription
If sWorkingDir  "" Then .WorkingDirectory = sWorkingDir
.Path = sTargetFile
' Verknüpfung speichern
.Save
End With
' Objekte zerstören
Set oLink = Nothing
Set oFolder = Nothing
Set oShell = Nothing
End Function


Wenn Du es in Dein Makro "reinpfriemeln" willst, dann sind diese Zeilen interessant:


Dim strPfad As String
strPfad = Environ("userprofile") & "\Desktop\"


Quelle:
http://www.vbarchiv.net/archiv/tipp_849.html
Servus
Case

Anzeige
AW: Shortcut auf Desktop
10.10.2007 12:35:00
Walburga
Hi Case
vielen Dank, das wars!!
Schönen Tag noch
Walburga

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige