Link auf dem Desktop

Forumthread: Link auf dem Desktop

03.10.2005 00:42:18

Jörg

Hallo zusammen,
kennt jemand ein Tool, das einen Link zur aktiven Datei auf dem Desktop generiert? Bei Doppelklick auf den Link soll sich die Exelmappe ohne die
Makroabfrage öffnen.
Grüße Jörg

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Link auf dem Desktop

03.10.2005 01:23:59

Nepumuk
AW: Link auf dem Desktop

03.10.2005 11:24:18

Jörg
AW: Link auf dem Desktop

03.10.2005 12:03:12

Nepumuk
Danke mT

03.10.2005 13:22:41

Jörg

AW: Link auf dem Desktop

03.10.2005 01:23:59

Nepumuk

Hi,
so:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Sub prcCreateLink()
    Dim objShell As Object, objShortcut As Object
    Dim strDesktopPath As String, strFileName As String
    Dim strPath As String
    On Error GoTo exit_err
    Set objShell = CreateObject("wscript.Shell")
    strFileName = Dir(ThisWorkbook.FullName)
    strPath = Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) _
        - Len(strFileName))
    If Not Len(strFileName) = 0 Then
        strDesktopPath = objShell.SpecialFolders.Item("Desktop")
        Set objShortcut = objShell.CreateShortcut(strDesktopPath & "\" & _
            strFileName & ".lnk")
        With objShortcut
            .TargetPath = objShell.ExpandEnvironmentStrings( _
                ThisWorkbook.FullName)
            .WorkingDirectory = objShell.ExpandEnvironmentStrings(strPath)
            .WindowStyle = 4
            .IconLocation = objShell.ExpandEnvironmentStrings( _
                Application.Path & "\excel.exe , 1")
            .Save
        End With
    Else
        Err.Raise Number:=vbObjectError + 1, Description:= _
            "Datei wurde noch nicht gespeichert."
    End If
    exit_sub:
    Set objShell = Nothing
    Set objShortcut = Nothing
    Exit Sub
    exit_err:
    MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
        Err.Description, 16, "Fehler"
    Resume exit_sub
End Sub

Damit die Makroabfrage nicht kommt, musst du die Makros signieren. Wie das geht, findest du hier: https://www.herber.de/index.html?https://www.herber.de/tutorial/2003/basics12.htm
Gruß
Nepumuk

AW: Link auf dem Desktop

03.10.2005 11:24:18

Jörg

Hallo Nepumuk,
danke für deine Mühe. Das ist nicht, was ich meine. Ich möchte einen Makro, der ein
VBS generiert, das die Exceldatei öffnet, dann entfällt die Makroabfrage. Den Code
für das VBS habe ich in der Recherche gefunden, was auch funktioniert.
Der Link soll dann auf das VBS weisen. Das VBS sollte im Verzeichnis der Exceldatei
abgelegt werden.
Grüße Jörg

AW: Link auf dem Desktop

03.10.2005 12:03:12

Nepumuk

Hi,
schreib das doch bitt beim nächsten mal gleich so.
Private Sub prcCreateScript()
    Dim objShell As Object
    Dim intFile As Integer
    Dim strFilename
    strFilename = Left$(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
    Reset
    intFile = FreeFile
    Open ThisWorkbook.Path & "\" & strFilename & ".vbs" For Output As #intFile
    Print #intFile, "set xlapp = createobject(" & Chr(34) & "excel.application" & Chr(34) & ")"
    Print #intFile, "xlapp.workbooks.open " & Chr(34) & ThisWorkbook.FullName & Chr(34)
    Print #intFile, "xlapp.visible = true"
    Print #intFile, "set xlapp = nothing"
    Close #intFile
    Set objShell = CreateObject("wscript.Shell")
    With objShell.CreateShortcut(objShell.SpecialFolders("Desktop") _
            & "\" & strFilename & ".lnk")
        .TargetPath = ThisWorkbook.Path & "\" & strFilename & ".vbs"
        .Save
    End With
    Set objShell = Nothing
End Sub

Gruß
Nepumuk

Danke mT

03.10.2005 13:22:41

Jörg

Hallo Nepumuk,
entschuldige, ich dachte ich hätte mich klar ausgedrückt.
Größe Jörg

Beliebteste Forumthreads (12 Monate)

Forumthread: Link auf dem Desktop

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread