Sub Ярлык()
    Dim sPath As String         'путь к файлу
    Dim sFold As String         'путь к вложенной папке
    Dim sPath1                  'путь к рабочему столу
    Dim sFileName As String     'Имя файла
    Dim LinkDesktop As Object
    Dim LinkFolder As Object
    Dim WshShell As Object
    Dim WshShell1 As Object
    sPath = ThisWorkbook.Path & "\"
    sFold = ThisWorkbook.Path & "\Ico"
    sFileName = ThisWorkbook.Name
    
    Set WshShell = CreateObject("WScript.Shell")
    sPath1 = WshShell.SpecialFolders("Desktop")
    
    Set LinkDesktop = WshShell.CreateShortcut(sPath1 & "\Мой ярлык.lnk") 'местоположение и имя ярлыка
    Set LinkFolder = WshShell.CreateShortcut(sPath1 & "\Папка.lnk")      'местоположение и имя ярлыка
    
    With LinkDesktop
        .Description = "Работаем с удовольствием!"          'Комментарий ярлыка на раб. столе
        .TargetPath = sPath & sFileName                     'ссылка на исходный файл
        .IconLocation = sPath & "Ico\Icon1.ico"             'ссылка на иконку
        .WindowStyle = 3                                    'Окно во весь экран
        .Save
    End With
    With LinkFolder
        .Description = "Вложенная папка"
        .TargetPath = sFold
        .IconLocation = sPath & "Ico\Icon1.ico"
        .Save
    End With
End Sub