Crée un raccourci et obtenir les repértoire spéciaux de windows

Télécharger le projet
Commenter

Description

Ce petit modules permet de simplifier la création de raccourci et d'obtenir facillement les

répertoirs spéciaux (bureau,menu démarrer,...)
Pratique pour une installation

Source / Exemple : 


'Petit modules qui simpifie la creation de raccourci et l'obtention des rep spéciaux
'par Pierre Fersing pierre.fersing@wandoo.fr le 12/07/02

Function GetSpecialFolder(FolderName) ' si on met as string ca marche pas ??????
'donne le chemin d'un répertoir spécial à partire de son nom ou de son ID

'Liste de repértoire spéciaux:
'Nom               : ID

'AllUsersDesktop   :0
'AllUsersStartMenu :1
'AllUsersPrograms  :2
'AllUsersStartup   :3
'Desktop           :4 10    Si qqun c'est pourquoi il y a deux ID pour desktop
'AppData           :5
'PrintHood         :6
'Templates         :7
'Fonts             :8
'NetHood           :9
'StartMenu         :11
'SendTo            :12
'Récent            :13
'Startup           :14
'Favorites         :15
'MyDocuments       :16
'Programs          :17

'Merci à Fbrt pour cette liste
'Normalement il n'y en a pas plus car un nombre plus petit que 0 ou plus grande que 17
'ca fait planté

Dim WSHShell As Object
Set WSHShell = CreateObject("WScript.Shell")
GetSpecialFolder = WSHShell.SpecialFolders(FolderName)
End Function

Sub MakeShortCut(ShortcutName As String, Target As String, Optional WorkingDirectory As 

String, Optional WindowsStyle As Integer = 4, Optional IconName As String, Optional 

IconIndex As Integer = 0)
'Fonction qui Crée un raccourci
'ShortcutName : Nom complet du raccourcie (ex: c:\windows\bureau\link.lnk)
'Target       : La cible du raccourcie (ex: c:\dev\asm\nasm\nasmide.exe)
'WorkingDirectory: Répertoire d'exécution, par defaut le répertoire contenant l'exécutable 

(ex: c:\dev\asm\src)
'WindowsStyle : Comment est affiché le programme: normal,reduit,agrandi... Par defaut: 

normal (comme pour shell en VB ex:4 = normal)
'IconName     : Chemin d'acces de l'icone, par default l'icone de l'exécutable cible (si 

non aucun) ( ex: c:\dev\asm.ico)
'IconIndex    : L'index de l'icone dans le fichier

'Merci à VBfrance pour les forum sur lequel j'ai trouvé ce que je cherchais
'et à Oliver68 qui a posté le message dont j'avais besoin sur le forum

'si il n'y a le .lnk à la fin on l'ajoute
If Right(ShortcutName, 4) <> ".lnk" Then ShortcutName = ShortcutName & ".lnk"

'If IsMissing(WorkingDirectory) Then  ca ne marche pas! Et je sais pas pourquoi. Si qqun 

sait, qu'il me le fasse savoir
If WorkingDirectory = "" Then
    'Valeur par defaut pour le repértoire de travail: le répertoire de l'exécutable
    Dim i As Integer, j As Integer
    i = 1
    Do
        j = i + 1
        i = InStr(j, Target, "\") ' on cherche un \
    Loop Until i = 0                    ' jusqu'a ce qu'il n'y en ait plus
    'j est la valeur de la position après du dernier \
    'on prend tout ce qu'il y a avant le dernier \ et on en ajoute un à la fin
    WorkingDirectory = Mid(Target, 1, j - 2) & "\"
End If

If IconName = "" Then
    'Si un n'y a pas d'icone, on prend l'icone de l'exécutable cible ou rien
    IconName = Target
End If

Dim WSHShell 'Pour Crée le raccourci et pour optenir les répertoir Spéciaux
Dim Shortcut 'notre raccourcie

Set WSHShell = CreateObject("WScript.Shell") ' on crée un objet Shell

' Création d'un objet raccourci
Set Shortcut = WSHShell.CreateShortcut(ShortcutName)
' Paramétrage du raccourci
'ExpandEnvironmentStrings permet de mettre des chose comme %windir%
Shortcut.TargetPath = WSHShell.ExpandEnvironmentStrings(Target)
Shortcut.WorkingDirectory = WSHShell.ExpandEnvironmentStrings(WorkingDirectory)
Shortcut.WindowStyle = WindowsStyle
Shortcut.IconLocation = WSHShell.ExpandEnvironmentStrings(IconName & " , " & IconIndex)

Shortcut.Save
End Sub

Conclusion :


Si il y a un problème laissez un commentaire.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_PierreF)