Selasa, 22 Maret 2016

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

 

This leaves me wondering why I bothered.

In particular :-

If (Not fso.folderexists(sCWIPEND)) Then MkDir sCWIPEND 

Derek Turner +++

From: "Paul Schreiner schreiner_paul@att.net [ExcelVBA]" <ExcelVBA@yahoogroups.com>
To: "ExcelVBA@yahoogroups.com" <ExcelVBA@yahoogroups.com>
Sent: Tuesday, 22 March 2016, 11:02
Subject: 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: Derek Turner <g4swy@yahoo.com>
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (9)

Save time and get your email on the go with the Yahoo Mail App
Get the beautifully designed, lighting fast, and easy-to-use, Yahoo Mail app today. Now you can access all your inboxes (Gmail, Outlook, AOL and more) in one place. Never delete an email again with 1000GB of free cloud storage.

----------------------------------
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

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

.

__,_._,___

Tidak ada komentar:

Poskan Komentar