EXCEL FEED: Re: [ExcelVBA] Re: Creating Shortcut to a Folder on the Desktop

Selasa, 22 Maret 2016

Re: [ExcelVBA] Re: Creating Shortcut to a Folder on the Desktop

Try this:
Sub Make_shortcut()
    Dim Stat
    Dim sCWIPEND
    Dim oWsh As Object
    Dim DesktopPath As String
    Dim Shortcut As String
    Dim oShortcut As Object
    Dim fso
        
    Set fso = CreateObject("Scripting.FileSystemObject")
    sCWIPEND = Environ("userprofile") & "\Documents\Complex Work Instructions\Pending\"
    Set oWsh = CreateObject("WScript.Shell")
    DesktopPath = oWsh.SpecialFolders("Desktop")
    Shortcut = DesktopPath & "\Complex_Work_Instructions.lnk"
    If (Not fso.folderexists(sCWIPEND)) Then MkDir sCWIPEND
    If (Not fso.fileexists(Shortcut)) Then
        Set oShortcut = oWsh.CreateShortCut(Shortcut)
        With oShortcut
            .TargetPath = sCWIPEND
            .Save
        End With
        Set oWsh = Nothing
        Set oShortcut = Nothing
    End If
End Sub 
Paul
-----------------------------------------
"Do all the good you can,
By all the means you can,
In all the ways you can,
In all the places you can,
At all the times you can,
To all the people you can,
As long as ever you can." - John Wesley
-----------------------------------------


 On Monday, March 21, 2016 4:08 PM, "Derek Turner g4swy@yahoo.com [ExcelVBA]" <ExcelVBA@yahoogroups.com> wrote:


 
I have rearranged  your code to show how to make the CreateShortcut re-usable :-

Option Explicit
Sub MainCallingProgram()
Dim sShortcutTitle As String, sFolderPath As String
    sShortcutTitle = "Work Instruction Pending"
    sFolderPath = Environ("userprofile") & "\Documents\Complex Work Instructions\Pending\"
    CreateShortCut sFolderPath, sShortcutTitle
End Sub

Sub CreateShortCut(sFullFileOrFolderPathWithExtension As String, sShortcutTitle As String)
Dim sPathDeskTop As String
    With CreateObject("WScript.Shell")
        sPathDeskTop = .SpecialFolders("Desktop") & "\"
        With .CreateShortCut(sPathDeskTop & sShortcutTitle & ".lnk")
            .TargetPath = sFullFileOrFolderPathWithExtension
            .Save
        End With
    End With
End Sub

To spell it out you should call the CreateShortcut from your main program with parameters created there in the main program. This encapsulates the shortcut creation functionality and separates that from the code that works out the folder path. Thus if you ever want to use this routine in any other program it is sitting there ready for use and you don't need to modify it and the parameter names tell you how to call the routine.

Regards

Derek Turner
England +++



    From: "garymust@yahoo.co.uk [ExcelVBA]" <ExcelVBA@yahoogroups.com>
 To: ExcelVBA@yahoogroups.com 
 Sent: Sunday, 20 March 2016, 20:51
 Subject: [ExcelVBA] Re: Creating Shortcut to a Folder on the Desktop
  

 Hi All

Thanks for all your replies. I couldn't quite get some of the example code to work as i need but it's led me in the right direction. The below code seems to be working as i need it to.

Any changes need ??

Sub CreateDesktopShortCut()

Dim sPathDeskTop As String, sShortcutTitle As String, sFolderPath As String

With CreateObject("WScript.Shell")

sPathDeskTop = .SpecialFolders("Desktop") & "\"
sShortcutTitle = "Work Instruction Pending"
sFolderPath = Environ("userprofile") & "\Documents\Complex Work Instructions\Pending\"

With .CreateShortCut(sPathDeskTop & sShortcutTitle & ".lnk")

.TargetPath = sFolderPath
.Save

End With

End With

End Sub



 

__._,_.___

Posted by: Paul Schreiner <schreiner_paul@att.net>

Reply via web post

•

Reply to sender

•

Reply to group

•

Start a New Topic

•

Messages in this topic (8)

----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA

----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com

----------------------------------

Visit Your Group