Украинская Баннерная Сеть
Hosting Ukraine

ProtoPlex: программы, форум, рейтинг, рефераты, рассылки!

Каталог авто сайтов



moskaliv.net

Создание ярлыков

Скачать исходник (4 кб)

После долгих поисков я остановился на следующих функциях (приведены ниже). К сожалению не знаю автора (отзовется укажу)
Создаем такой модуль:

Option Explicit

Enum ShortCutDest

DeskTop
Programs
StartMenu
StartUp

End Enum

Public Function CreateLink(dest As ShortCutDest, ByVal sName As String, ByVal sPath As String, Optional HotKey As String = "", Optional sIcon As String = "", Optional sWorkingDirectory As String = "", Optional sSubFolder As String = "", Optional WinStyle As Integer = vbNormalFocus)

Dim WshShell As Object
Dim oShellLink As Object
Dim sLinkPath As String

Set WshShell = CreateObject("WScript.Shell")

Select Case dest

Case DeskTop

sLinkPath = WshShell.SpecialFolders("Desktop")

Case StartMenu

sLinkPath = WshShell.SpecialFolders("StartMenu")

Case StartUp

sLinkPath = WshShell.SpecialFolders("StartUp")

Case Programs

sLinkPath = WshShell.SpecialFolders("Programs")

End Select

On Error Resume Next

If sSubFolder <> "" Then

sLinkPath = sLinkPath & "\" & sSubFolder

If Dir(sLinkPath) = "" Then MkDir sLinkPath

End If

On Error GoTo 0

Set oShellLink = WshShell.CreateShortCut(dest & "\" & sName & ".lnk")
oShellLink.WindowStyle = WinStyle
' oShellLink.HotKey = sHotKey
oShellLink.TargetPath = sPath
oShellLink.IconLocation = sIcon
oShellLink.Description = sName
oShellLink.WorkingDirectory = sWorkingDirectory
oShellLink.Save
Set oShellLink = Nothing
Set WshShell = Nothing

End Function

Public Function CreateLinkFolder(dest As String, ByVal sName As String, ByVal sPath As String, Optional HotKey As String = "", Optional sIcon As String = "", Optional sWorkingDirectory As String = "", Optional sSubFolder As String = "", Optional WinStyle As Integer = vbNormalFocus)

Dim WshShell As Object
Dim oShellLink As Object
Dim sLinkPath As String

Set WshShell = CreateObject("WScript.Shell")

Select Case dest

Case DeskTop

sLinkPath = WshShell.SpecialFolders("Desktop")

Case StartMenu

sLinkPath = WshShell.SpecialFolders("StartMenu")

Case StartUp

sLinkPath = WshShell.SpecialFolders("StartUp")

Case Programs

sLinkPath = WshShell.SpecialFolders("Programs")

End Select

On Error Resume Next

If sSubFolder <> "" Then

sLinkPath = sLinkPath & "\" & sSubFolder

If Dir(sLinkPath) = "" Then MkDir sLinkPath

End If

On Error GoTo 0

Set oShellLink = WshShell.CreateShortCut(dest & "\" & sName & ".lnk")
oShellLink.WindowStyle = WinStyle
' oShellLink.HotKey = sHotKey
oShellLink.TargetPath = sPath
oShellLink.IconLocation = sIcon
oShellLink.Description = sName
oShellLink.WorkingDirectory = sWorkingDirectory
oShellLink.Save
Set oShellLink = Nothing
Set WshShell = Nothing

End Function

Добавляем модуль в проект и затем, легко и просто создаем ярлык

Private Sub cmdCreateLinc_Click()
Dim rez As Long

CreateLinkFolder Folder, Name, FileFolder, "", "", "", "", 1

End Sub

Где:
Folder - папка где мы создаем ярлык
Name - имя ярлыка
FileFolder - папка или файл к которому создаем ярлык.
Остальные значения мне неизвестны
Если кто знает

Если у Вас есть предложения то Вам сюда.
Все находящиеся здесь является бесплатным. Если Вы желаете поддержать автора то Вам сюда