Put desktop shortcut inside folder

Hello,
I am able to create a desktop shortcut, using cell values, with the attached code.
Can someone show me how to make a copy of the same shortcut, with code in the same module, and put it into a folder.  The  folder will also be referred to as a dynamic cell value.
Thank you,
Public Sub Shortcut2()
Dim WSHShell As Object
Set WSHShell = CreateObject("WScript.Shell")

Dim MyShortcut As Object
Dim DesktopPath As String


DesktopPath = WSHShell.SpecialFolders("Desktop")

Set MyShortcut = WSHShell.CreateShortcut(DesktopPath & _
"\Canadian Life Income Planr.lnk")

MyShortcut.TargetPath = WSHShell.ExpandEnvironmentStrings(Range("A1").Value & "\Choose Case.xls")
MyShortcut.WorkingDirectory = WSHShell.ExpandEnvironmentStrings("%windir%")
MyShortcut.WindowStyle = 4
MyShortcut.IconLocation = (Range("A2").Value & "\Shortcut.bmp")
MyShortcut.Save

Set MyShortcut = Nothing
Set WSHShell = Nothing

End Sub

Open in new window

davidamAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

HainKurtSr. System AnalystCommented:
just create a new object set properties same, but different location

Dim MyShortcut2 As Object
Set MyShortcut2 = WSHShell.CreateShortcut(Range("A3").Value & _"\Canadian Life Income Planr.lnk")
MyShortcut2.TargetPath = WSHShell.ExpandEnvironmentStrings(Range("A1").Value & "\Choose Case.xls")
MyShortcut2.WorkingDirectory = WSHShell.ExpandEnvironmentStrings("%windir%")
MyShortcut2.WindowStyle = 4
MyShortcut2.IconLocation = (Range("A2").Value & "\Shortcut.bmp")
MyShortcut2.Save

or create a function and call it twice with different parameters...

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
RobSampsonCommented:
Hi, try this.

What I've done is change the shortcut creation to a Sub, to pass the link file name, the target path, the working directory, and the icon location as parameters.

That way, you only need to call the sub, passing the appropriate parameters, and the shortcut is created.  In your case, with the second call to CreateShortcut, I have only changed the first parameter to create the shortcut in C:\OtherFolder

Regards,

Rob.
Public Sub Shortcut2()
Dim WSHShell As Object
Set WSHShell = CreateObject("WScript.Shell")

Dim MyShortcut As Object
Dim DesktopPath As String

DesktopPath = WSHShell.SpecialFolders("Desktop")

CreateShortcut DesktopPath & "\Canadian Life Income Planr.lnk", WSHShell.ExpandEnvironmentStrings(Range("A1").Value & "\Choose Case.xls"), WSHShell.ExpandEnvironmentStrings("%windir%"), (Range("A2").Value & "\Shortcut.bmp")

CreateShortcut "C:\otherfolder" & "\Canadian Life Income Planr.lnk", WSHShell.ExpandEnvironmentStrings(Range("A1").Value & "\Choose Case.xls"), WSHShell.ExpandEnvironmentStrings("%windir%"), (Range("A2").Value & "\Shortcut.bmp")

Set WSHShell = Nothing

End Sub

Sub CreateShortcut(strLinkName, strTargetPath, strWorkingDir, strIconLocation)
	Set MyShortcut = WSHShell.CreateShortcut(strLinkName)
	
	MyShortcut.TargetPath = strTargetPath
	MyShortcut.WorkingDirectory = strWorkingDir
	MyShortcut.WindowStyle = 4
	MyShortcut.IconLocation = strIconLocation
	MyShortcut.Save
	
	Set MyShortcut = Nothing
End Sub

Open in new window

RobSampsonCommented:
Oh, didn't refresh....I did what HainKurt suggested.

Rob.
Become a Certified Penetration Testing Engineer

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

davidamAuthor Commented:
This returns run time error 91
Object variable or With block variable not set
 on line:
Set MyShortcut2 = WSHShell.CreateShortcut(Range("A3").Value & "\Canadian Life Income Planr.lnk")
davidamAuthor Commented:
Actually, I am now totally confused.  I want the same shortcut to be pasted onto the desktop as well as into a folder...they both will point to the same location.
RobSampsonCommented:
If that's HainKurt's code, you're probably missing the WSHShell object....
RobSampsonCommented:
Try my code.....it will create the same shortcut, just in two different locations.

Rob.
davidamAuthor Commented:
Rob I am not really getting this.  
on this line I get an error:
CreateShortcut "C:\otherfolder"...Is this where I tell it where to put the other shortcut... and how do I do that?
RobSampsonCommented:
This line calls the CreateShortcut sub, creating your original desktop shortcut:
CreateShortcut DesktopPath & "\Canadian Life Income Planr.lnk", WSHShell.ExpandEnvironmentStrings(Range("A1").Value & "\Choose Case.xls"), WSHShell.ExpandEnvironmentStrings("%windir%"), (Range("A2").Value & "\Shortcut.bmp")

Open in new window


by passing four parameters to the CreateShortcut sub
DesktopPath & "\Canadian Life Income Planr.lnk"
WSHShell.ExpandEnvironmentStrings(Range("A1").Value & "\Choose Case.xls")
WSHShell.ExpandEnvironmentStrings("%windir%")
(Range("A2").Value & "\Shortcut.bmp")

They are the shortcut location, the target path, the working directory, and the icon location.

So, in the second call to the function we pass the same, except change the first path:
"C:\otherfolder" & "\Canadian Life Income Planr.lnk"
WSHShell.ExpandEnvironmentStrings(Range("A1").Value & "\Choose Case.xls")
WSHShell.ExpandEnvironmentStrings("%windir%")
(Range("A2").Value & "\Shortcut.bmp")

So, the second shortcut should get created at
C:\otherfolder\Canadian Life Income Planr.lnk

What does the error say?

Regards,

Rob.
davidamAuthor Commented:
OK, I copied the code exactly and I get a run time 424 object reuqired at this line:
   Set MyShortcut = WSHShell.CreateShortcut(strLinkName)
RobSampsonCommented:
OK, variables are being picky...try this.

Regards,

Rob.
Public Sub Shortcut2()
Dim WSHShell As Object
Set WSHShell = CreateObject("WScript.Shell")

Dim DesktopPath As String

DesktopPath = WSHShell.SpecialFolders("Desktop")

CreateShortcut DesktopPath & "\Canadian Life Income Planr.lnk", WSHShell.ExpandEnvironmentStrings(Range("A1").Value & "\Choose Case.xls"), WSHShell.ExpandEnvironmentStrings("%windir%"), (Range("A2").Value & "\Shortcut.bmp")

CreateShortcut "C:\otherfolder" & "\Canadian Life Income Planr.lnk", WSHShell.ExpandEnvironmentStrings(Range("A1").Value & "\Choose Case.xls"), WSHShell.ExpandEnvironmentStrings("%windir%"), (Range("A2").Value & "\Shortcut.bmp")

Set WSHShell = Nothing

End Sub

Sub CreateShortcut(strLinkName, strTargetPath, strWorkingDir, strIconLocation)
	Dim MyShortcut As Object
	Dim WSHShell As Object
	Set WSHShell = CreateObject("WScript.Shell")
	Set MyShortcut = WSHShell.CreateShortcut(strLinkName)
	
	MyShortcut.TargetPath = strTargetPath
	MyShortcut.WorkingDirectory = strWorkingDir
	MyShortcut.WindowStyle = 4
	MyShortcut.IconLocation = strIconLocation
	MyShortcut.Save
	
	Set MyShortcut = Nothing
End Sub

Open in new window

davidamAuthor Commented:
Rob,
I am really messed up here...starting again with just writing a second procedure
davidamAuthor Commented:
Rob,
I put the above in before seeing your latest.  Tried it and I get error:
 Unable to save C:\otherfolder....
I dont see where we are telling it what the other folder is
davidamAuthor Commented:
OK...I changed 'other folder to Range("A3").Value and it worked
RobSampsonCommented:
Glad you got it sorted.

Rob.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.