Accueil > > > LNKUPDATER
LNKUPDATER
Information sur la source
Description
Assemblage de quelques extraits de code VBS, permettant de mettre à jour tous les racourcis Windows se trouvant dans un répertoire donné (ainsi que dans tous ses sous-répertoires). Par exemple, si vous avez des documents sous X: et un dossier avec des raccourcis s'y rattachant, et que vous déplacez les documents sous Y:, ce script vous permettra de remplacer "X:" par "Y:" dans tous les raccourcis.
Source
- '-----------------------------------------------------
- 'Titre : lnkUpdater
- 'Fonction : Parcours récursif d'un répertoire pour mettre à jour les raccourcis qu'il contient (en cas de déplacement de la cible)
- 'Auteur : Vladislav IV
- 'Date : 14/04/2007
-
- '+-----Sources-----+
- 'http://www.vbfrance.com
- 'http://vb.developpez.com
- 'http://www.bellamyjc.org
- '-----------------------------------------------------
-
-
- '-----Fonctions et procédures-----
- sub updateLink(cheminLnk, ancienneChaine, nouvelleChaine)
- 'remplace toutes les occurences de ancienneChaine par nouvelleChaine dans la cible et le répertoire de travail du raccourcis
- set lnk = WshShell.CreateShortcut(cheminLnk)
- lnk.TargetPath = replace(lnk.TargetPath, ancienneChaine, nouvelleChaine)
- lnk.WorkingDirectory = replace(lnk.WorkingDirectory, ancienneChaine, nouvelleChaine)
- lnk.Save
- end sub
-
-
- sub updateDir(rep, ancienneChaine, nouvelleChaine)
- 'traite les raccourcis contenus dans le répertoire, puis récursivement tous les sous-répertoires
- Dim FSO, ssrep, racc
- Set FSO = CreateObject("Scripting.FileSystemObject")
- If FSO.FolderExists(rep) Then
- 'traite les raccourcis
- For each racc in FSO.GetFolder(rep).Files
- if right(racc, len(racc) -InstrRev(racc, ".")) = "lnk" then 'vérifie si le fichier porte bien l'extension d'un raccourci
- call updateLink(racc, ancienneChaine, nouvelleChaine)
- end if
- Next
-
- 'traite les sous-répertoires
- For each ssrep in FSO.GetFolder(rep).SubFolders
- call updateDir(ssrep, ancienneChaine, nouvelleChaine)
- Next
- End If
- end sub
-
- ' ----------------------------------------------------------
- ' Script VBS de boite de dialogue de sélection de dossier
- ' JC BELLAMY © 2001
- ' ----------------------------------------------------------
- 'ce code a été modifié par mes soins, allez voir www.bellamyjc.org pour l'original.
- function BrowseForDir()
- BIF_returnonlyfsdirs = &H0001
- BIF_dontgobelowdomain = &H0002
- BIF_editbox = &H0010
- BIF_validate = &H0020
- BIF_browseforcomputer = &H1000
-
- Dim shell, item
- Set shell = WScript.CreateObject("Shell.Application")
- flag = BIF_returnonlyfsdirs
- titre = "Choisir un répertoire"
- Set Item = shell.BrowseForFolder(0,titre,flag, dirinit)
- If IsValue(Item) Then
- Result = Item.Title
- ' Test si on a sélectionné la racine d'une partition
- recherche = InStr(1, Result, ":")
- If recherche = 0 Then
- 'pas racine
- Result = Item.ParentFolder.ParseName(Item.Title).Path
- else
- 'racine, récupère la lettre de lecteur (avec ':')
- Result = Mid(Result, recherche-1, 2)
- msg = "Vous avez sélectionné une racine. Le traitement peut prendre du temps, et compromettre l'intégrité de votre ordinateur. Confirmez-vous votre choix ?"
- ok = MsgBox(msg, vbOkCancel, "Attention !")
- if ok = vbCancel then
- Result = ""
- end if
- End If
- else
- Result = ""
- End If
- BrowseForDir = Result
- end function
-
- ' Test de validité de l'objet retourné par BrowseForFolder
- ' On ne peut pas utiliser "IsObject", qui retourne toujours "true"
- Function IsValue(obj)
- Dim tmp
- On Error Resume Next
- tmp = " " & obj
- If Err <> 0 Then IsValue = False Else IsValue = True
- On Error GoTo 0
- End Function
- ' ----------------------------------------------------------
-
-
- '-----Programme principal-----
- set WshShell = WScript.CreateObject("WScript.Shell")
- rep = BrowseForDir() 'sélection du répertoire
- if rep <> "" then
- ancienneChaine = InputBox("Chaine à rechercher (ne peut être vide)")
- if ancienneChaine <> "" then
- nouvelleChaine = InputBox("Remplacer par")
- if ancienneChaine = nouvelleChaine then
- MsgBox "Traitement inutile : vous avez entré deux valeurs identiques.", vbCritical
- else
- if MsgBox("Lancer le traitement ?", vbYesNo) = vbYes then
- call updateDir(rep, ancienneChaine, nouvelleChaine) 'lance le traitement
- MsgBox "Traitement effectué."
- end if
- end if
- end if
- end if
'-----------------------------------------------------
'Titre : lnkUpdater
'Fonction : Parcours récursif d'un répertoire pour mettre à jour les raccourcis qu'il contient (en cas de déplacement de la cible)
'Auteur : Vladislav IV
'Date : 14/04/2007
'+-----Sources-----+
'http://www.vbfrance.com
'http://vb.developpez.com
'http://www.bellamyjc.org
'-----------------------------------------------------
'-----Fonctions et procédures-----
sub updateLink(cheminLnk, ancienneChaine, nouvelleChaine)
'remplace toutes les occurences de ancienneChaine par nouvelleChaine dans la cible et le répertoire de travail du raccourcis
set lnk = WshShell.CreateShortcut(cheminLnk)
lnk.TargetPath = replace(lnk.TargetPath, ancienneChaine, nouvelleChaine)
lnk.WorkingDirectory = replace(lnk.WorkingDirectory, ancienneChaine, nouvelleChaine)
lnk.Save
end sub
sub updateDir(rep, ancienneChaine, nouvelleChaine)
'traite les raccourcis contenus dans le répertoire, puis récursivement tous les sous-répertoires
Dim FSO, ssrep, racc
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(rep) Then
'traite les raccourcis
For each racc in FSO.GetFolder(rep).Files
if right(racc, len(racc) -InstrRev(racc, ".")) = "lnk" then 'vérifie si le fichier porte bien l'extension d'un raccourci
call updateLink(racc, ancienneChaine, nouvelleChaine)
end if
Next
'traite les sous-répertoires
For each ssrep in FSO.GetFolder(rep).SubFolders
call updateDir(ssrep, ancienneChaine, nouvelleChaine)
Next
End If
end sub
' ----------------------------------------------------------
' Script VBS de boite de dialogue de sélection de dossier
' JC BELLAMY © 2001
' ----------------------------------------------------------
'ce code a été modifié par mes soins, allez voir www.bellamyjc.org pour l'original.
function BrowseForDir()
BIF_returnonlyfsdirs = &H0001
BIF_dontgobelowdomain = &H0002
BIF_editbox = &H0010
BIF_validate = &H0020
BIF_browseforcomputer = &H1000
Dim shell, item
Set shell = WScript.CreateObject("Shell.Application")
flag = BIF_returnonlyfsdirs
titre = "Choisir un répertoire"
Set Item = shell.BrowseForFolder(0,titre,flag, dirinit)
If IsValue(Item) Then
Result = Item.Title
' Test si on a sélectionné la racine d'une partition
recherche = InStr(1, Result, ":")
If recherche = 0 Then
'pas racine
Result = Item.ParentFolder.ParseName(Item.Title).Path
else
'racine, récupère la lettre de lecteur (avec ':')
Result = Mid(Result, recherche-1, 2)
msg = "Vous avez sélectionné une racine. Le traitement peut prendre du temps, et compromettre l'intégrité de votre ordinateur. Confirmez-vous votre choix ?"
ok = MsgBox(msg, vbOkCancel, "Attention !")
if ok = vbCancel then
Result = ""
end if
End If
else
Result = ""
End If
BrowseForDir = Result
end function
' Test de validité de l'objet retourné par BrowseForFolder
' On ne peut pas utiliser "IsObject", qui retourne toujours "true"
Function IsValue(obj)
Dim tmp
On Error Resume Next
tmp = " " & obj
If Err <> 0 Then IsValue = False Else IsValue = True
On Error GoTo 0
End Function
' ----------------------------------------------------------
'-----Programme principal-----
set WshShell = WScript.CreateObject("WScript.Shell")
rep = BrowseForDir() 'sélection du répertoire
if rep <> "" then
ancienneChaine = InputBox("Chaine à rechercher (ne peut être vide)")
if ancienneChaine <> "" then
nouvelleChaine = InputBox("Remplacer par")
if ancienneChaine = nouvelleChaine then
MsgBox "Traitement inutile : vous avez entré deux valeurs identiques.", vbCritical
else
if MsgBox("Lancer le traitement ?", vbYesNo) = vbYes then
call updateDir(rep, ancienneChaine, nouvelleChaine) 'lance le traitement
MsgBox "Traitement effectué."
end if
end if
end if
end if
Conclusion
Si vous spécifiez une destination qui n'existe pas (par exemple, changer "X:\" pour "toto:\"), les raccourcis seront modifiés, mais à l'appel ils reviendront à leur cible initiale.
Je n'ai jamais essayé ce script sur une racine... Quoi qu'il en soit, testez-le d'abord sur des fichiers et raccourcis bidon !
A la base, j'ai assemblé ce script pour mettre à jour tous les raccourcis dans "Documents and Settings", après le déplacement de "Program Files" sur une autre partition. Mais tout ceci fera prochainement l'objet d'un article sur technos-sources.com !
Historique
- 31 octobre 2007 12:02:22 :
- Retrait de mon nom de la source pour éviter le harcèlement.
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Changer priorité processus (pas le current) [ par Stephane ]
Salut a tous Voila, on trouve partout sur internet, des sources pour modifier la priorité de l'appli en cours d'execution, mais moi j'aurais bes
Comment changer toutes le couleurs des formes [ par Alucard666 ]
Bonjour à tous,Avant toute chose :Je suis nouveau sur ce site et je dois dire qu'il est trés complet et qu'il permet d'avoir des sources fiables qui p
progressbar changer la couleur [ par bidouille007 ]
Bonjour Je cherche en vain le moyen de modifier la couleur de la barre de progression au style marquee mais que je fasse je n'arrive pas à mettre la
modifier l'octet d'un fichier [ par Zeroc00l ]
Salut all !1) Merci de lire cette question.2)J'aimerais savoir comment modifier un nombre n d'octet(s) tel que le premier octet à changer soit le ieme
modifier l'octet d'un fichier [ par Zeroc00l ]
Salut all !1) Merci de lire cette question.2)J'aimerais savoir comment modifier un nombre n d'octet(s) tel que le premier octet à changer soit le ieme
Changer le nom d'une Feuille Excel [ par nagstef ]
Bonjour !J'utilise cette formule afin de modifier ou récupérer des données de différentes cellules d'un classeur Excel.classeur.wo
Changer DATE de Windows [ par fabienfs ]
Bonjour, Je cherche à pouvoir modifier la date de Windows en VB.Net. Le but n'est donc pas de modifier la date de Windows dans mon appli mai bien mod
Modifier Back color... [ par TomTom27 ]
BonjourJe désire changer la couleur de fond, d'une ligne de ma list view, je n'arrive a changer que tout les back color de toutes les lignes.Merci
changer les droits des fichiers ? [ par le1scorpion1noir ]
salut a tous je voulais savoir comment je peux modifier les droits d'un fichier a laide de Visual basic pour qu'on peux pas modifier ce fichier que s
changer l'icone d'une feuille vb6 et celui d'un controle commadeboutton [ par cophy ]
bonjour s'il vous plait comment on procède pour changer l'icone d'une feuille vb6? je voudrais aussi afficher une icone sur un controle commande butt
|
Derniers Blogs
[SHAREPOINT] LES SESSIONS TECHDAYS 2012.[SHAREPOINT] LES SESSIONS TECHDAYS 2012. par Patrick Guimonet
Voici donc pour ceux qui n'ont pas pu venir, ou ceux qui n'ont pas pu toutes les suivre la liste des sessions SharePoint aux TechDays 2012, que je mettrais à jour dès que les liens des vidéo seront disponibles. Ou ici : http...
Cliquez pour lire la suite de l'article par Patrick Guimonet TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3 par ROMELARD Fabrice
Speaker: Bernard Ourghanlian Cette session est comme chaque jour transmise en live par BrainSonic, et j'ai donc suivi cette troisième pleinière par ce moyen sur mon iPad . Elle est dédiée comme chaque année à la mise en perspective de l'é...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice MISHRA READER : UN LECTEUR RSS TRèS ZUNE STYLE EN OPEN SOURCE !MISHRA READER : UN LECTEUR RSS TRèS ZUNE STYLE EN OPEN SOURCE ! par Vko
Hier durant une session dédiée aux Techdays 2012, j'ai eu le plaisir d'annoncer la sortie de la Béta 2 de Mishra Reader. C'est quoi ? Pour les utilisateurs, c'est une vraie expérience de lecture de flux RSS sur Windows. Rien à voir avec les produit...
Cliquez pour lire la suite de l'article par Vko [FRAMEWORK 4] LES TASKS ET LE THREAD UI[FRAMEWORK 4] LES TASKS ET LE THREAD UI par fathi
Je viens de passer quelques temps au TechDay's et j'ai pu voir pas mal de session intéressante. Par contre une chose m'a un peu étonné lors de certaines de ces sessions qui abordaient les améliorations du framework .NET (donc le 4.5) : en gros, bea...
Cliquez pour lire la suite de l'article par fathi WORKFLOW FOUNDATION 3 A UN PIED DANS LA TOMBEWORKFLOW FOUNDATION 3 A UN PIED DANS LA TOMBE par JeremyJeanson
Depuis déjà un an, je conseille vivement les utilisateurs de Workflow Foundation 3 à migrer vers la version 4. L'information qui va suivre ne devrait donc pas trop prendre au dépourvu les personnes qui m'ont suivi. Je profite de ce poste, pour faire le re...
Cliquez pour lire la suite de l'article par JeremyJeanson
Logiciels
Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Easy-Planning (1.0.0.1)EASY-PLANNING (1.0.0.1)Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ... Cliquez pour télécharger Easy-Planning COLLECTOR PLUS (3.00B)COLLECTOR PLUS (3.00B)COLLECTOR PLUS version 3.00B est un logiciel utilisant une base de données alimentée par :
- L... Cliquez pour télécharger COLLECTOR PLUS PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V7.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V7.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO LettresFaciles 2011 (8.0.0.1)LETTRESFACILES 2011 (8.0.0.1)LettresFaciles est un logiciel facilitant la création et la rédaction de lettres types.
Son inte... Cliquez pour télécharger LettresFaciles 2011
|