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

Soyez le premier à donner votre avis sur cette source.

Vue 8 865 fois - Téléchargée 475 fois

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.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_CanisLupus
Messages postés
3758
Date d'inscription
mardi 23 septembre 2003
Statut
Modérateur
Dernière intervention
13 mars 2006
6 -
Pour les valeurs d'ID Il y a une bonne piste sur :

http://www.mvps.org/vbnet/api/_func/methg.htm

et voir GetSpecialFolderLocation

ou alors voir dans l'API guide de allapi.net

ou directement sur :

http://www.mentalis.org/apilist/SHGetSpecialFolderLocation.shtml

Cordialement

CaniLupus
JMC70
Messages postés
77
Date d'inscription
samedi 9 novembre 2002
Statut
Membre
Dernière intervention
6 juillet 2014
-
En tout cas ça fonctionne bien si on passe le nom du dossier à la place de l'ID. Par exemple
MsgBox GetSpecialFolder("desktop")
retourne bien le dossier du bureau.
A tester en NT, XP et 2000 !
Merci pour ce code très pratique de toute façon.
JMC70
Messages postés
77
Date d'inscription
samedi 9 novembre 2002
Statut
Membre
Dernière intervention
6 juillet 2014
-
Même problême que pour Grizeli31 : les id ne correspondent pas sur ma machine en win98 (sous VB6) et ne vont que jusqu'à 9 : le bureau est par exemple en 7 et 1, mes documents en 13. C'est inquiétant car l'intérêt du programme c'est justement de retrouver les chemins quel que soit le SE.
cs_PierreF
Messages postés
33
Date d'inscription
mercredi 15 mai 2002
Statut
Membre
Dernière intervention
24 octobre 2003
-
Le répertoir temp c'est le répertoir temporaire (c:windows emp pour les win9x et c:documents and settings<nom de l'utilisateur>Local SettingsTemp pour les win NT).
Linkman
Messages postés
113
Date d'inscription
lundi 23 décembre 2002
Statut
Membre
Dernière intervention
24 juin 2009
-
Heuuu, je voudré savoir, bon je vé passé pour un noob, mé bon.
Le dossier Templates c le dossier Temp, non ?
Si oui, ba moi g windows XP, et s'a m'en mène ds le dossier "Modèles".... :o(
Dsl pour l'orth @+

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.