VBA code help to create a short cut to a folder in another folder

[maverick93]

I need some help creating a short cut to a folder using VBA.
I have a command button that creates two folders, the first is the folder where the workbook is being saved and the second is another folder that is saved in an entirely different spot.

I would like to create a shortcut to this second folder in the first folder (the same place the workbook is saved).

Private Sub CommandButton2_Click()
' Create a Quote folder
        MkDir Left(Application.ThisWorkbook.Path, InStr(Application.ThisWorkbook.Path, "FORMS") - 1) & Sheets("Data").Range("E2") & " -- #" & Sheets("Data").Range("E1") & " -- " & Sheets("Data").Range("E3")

'Saves the file in the Quote folder
    ActiveWorkbook.SaveAs Filename:= _
             Left(Application.ThisWorkbook.Path, InStr(Application.ThisWorkbook.Path, "FORMS") - 1) & Sheets("Data").Range("E2") & " -- #" & Sheets("Data").Range("E1") & " -- " & Sheets("Data").Range("E3") & "\Taper Cut List & Drawing - V1 --  " & Sheets("Data").Range("E2") & " -- #" & Sheets("Data").Range("E1") & ".xlsm" _
            , FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
            ReadOnlyRecommended:=False, CreateBackup:=False
            
' Create a new TAPERPLUS folder
        MkDir "C:\Users\" & Environ("username") & "\" & Mid(Application.ThisWorkbook.Path, InStr(Application.ThisWorkbook.Path, "Dropbox"), InStr(Application.ThisWorkbook.Path, "LJS") - InStr(Application.ThisWorkbook.Path, "Dropbox")) & "TAPERPLUS\" & Right(Application.ThisWorkbook.Path, Len(Application.ThisWorkbook.Path) - Len(Left(Application.ThisWorkbook.Path, InStr(Application.ThisWorkbook.Path, "Offs\") + 4))) & Sheets("Data").Range("E27").Value & ".DIR\"

'Create a Shortcut of the New TAPERPLUS folder in The Quote folder
'???????? Not sure what that code should be

End Sub

Thanks for the help!

 

[Jaafar Tribak]

You can use the following sub:

Sub CreateShortcutToFolder(ByVal ShortcutPathName As String, ByVal TargetFolderPath As String)

    With CreateObject("WScript.Shell").CreateShortcut(ShortcutPathName)
        .TargetPath = TargetFolderPath
        .Description = "Shortcut to: " & TargetFolderPath
         .Save
    End With
    
End Sub

Call it like this :
Call CreateShortcutToFolder("SHORTCUT_PATH\SHORTCUT_NAME.lnk", "TARGET_FOLDER_PATH")

 

[maverick93]

Thank Jaafar I appreciate your help greatly. Unfortunately I'm more of a VBA Hack and I'm not sure what exactly what I need to replace in your code to make this work. I have tried below to create a simple example and implement it in your code. Can you please double check and see if I am correct in my thought process. Again thank you for your help.



Just so I can get an Idea of what I need to replace can we use the example below.
The folder that the worksheet is in and I want to place the folder shortcut is: C:\Desktop\Quote Folder
The folder that I want make a shortcut of is: C:\Desktop\ Taperplus

Would this be the correct call to use --- Call CreateShortcutToFolder("C:\Desktop\ Taperplus\TAPERPLUS - SHORTCUT.lnk", "C:\Desktop\Quote Folder")

Sub CreateShortcutToFolder(ByVal ShortcutPathName As String, ByVal TargetFolderPath As String)

    With CreateObject("WScript.Shell").CreateShortcut(" C:\Desktop\ Taperplus")
        .TargetPath = TargetFolderPath
        .Description = "Shortcut to: C:\Desktop\ Taperplus " & TargetFolderPath
         .Save
    End With
    
End Sub