Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 12 PS5 Orange Livebox ChatGPT Mini PC
Entraide Applications Microsoft Office Excel modifier tous les fichiers "*.lnk" (les raccourcis)

modifier tous les fichiers "*.lnk" (les raccourcis)

4 réponses
Avatar
Alfred WALLACE
Bonjour,
est-il possible de parcourir une arborescence, et, pour
chaque fichier dont l'extention est ".lnk", donc, pour les fichiers de
type raccourcis , je modifie la propri=E9t=E9 "Cible" et "D=E9marrer dans".

j'ai dans ma feuille, dans la colonne A la chaine =E0 remplacer, et dans
la
colonne B, la nouvelle valeur de la chaine A.

Merci pour votre aide.

Jos=E9
Signaler un problème avec ce contenu

4 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
michdenis
Bonjour,

Regarde ce qui suit :

Tu dois adapter certains noms d'objets propres à ton application.
+
Tu dois ajouter un bout de code, car ta question n'était pas précise sur le sujet

J'ai pris pour acquis que les noms des anciens fichiers
étaient en A:A et les noms des nouveaux fichiers étaient en B:B

Le nom du raccourci n'est pas modifié, mais pointe sur ton nouveau fichier !
'---------------------------------
Sub Modifier_Fichier_Raccourci()
Dim ObjShell As Object, ObjFolder As Object
Dim WshShell As Object, Lien As Object
Dim Chemin As String, Fichier As String
Dim Raccourci As String, Temp As String
Dim X As Variant, CheminTemp As String
Dim Rg As Range

'Emplacement du répertoire où sont tes fichiers
Chemin = "c:"

'Liste de tes fichiers en A:A
'Liste des nouveaux fichiers en B:B
With Worksheets("Sheet1") 'nom feuille à modifier
'Plage à adapter
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'Création de l'instance
Set WshShell = CreateObject("WScript.Shell")
Set ObjShell = CreateObject("Shell.Application")
For Each ObjFolder In ObjShell.Namespace("c:").Items
If ObjFolder.IsLink Then
'Récupérer chemin et fichier des raccourci
Raccourci = ObjFolder.Path
'Objet raccourci lui-même (objet)
Set Lien = WshShell.createShortcut(Raccourci)
'Extraction du nom du fichier sur lequel pointe le raccourci
Temp = Split(Lien.TargetPath, "")(UBound(Split(Lien.TargetPath, "")))
'Vérifier si ce fichier est dans la plage Rg
X = Application.Match(Temp, Rg, 0)
If Not IsError(X) Then
'Extraction du chemin où est ce raccourci
CheminTemp = Replace(Lien.TargetPath, Temp, Rg(X, 1).Offset(, 1).Value)

'**************************
'Si tu veux substituer une partie de la chaîne du chemin
'Par autre chose, tu peux utiliser ceci : ancien et nouveau à définir
'CheminTemp = Application.WorksheetFunction.Substitute(CheminTemp, "Ancien", "Nouveau")
'**************************

'vérifier si l'extension du fichier existe... tu choisis l'extension de ton choix
If LCase(Right(CheminTemp, 5)) = ".xlsx" Then
Else
'extension de ton choix si nécessaire
CheminTemp = CheminTemp & ".xlsx"
End If

'Redéfinir le raccourci avec le nouveau nom fichier est le nouveau chemin
Lien.TargetPath = CheminTemp
Lien.WindowStyle = 1
Lien.IconLocation = "Excel.exe, 0"
Lien.Description = "Pour le plaisir" 'Optionnel
Lien.Hotkey = "CTRL+ALT+M" 'Optionnel
Lien.WorkingDirectory = Chemin
Lien.Save
Else
Err = 0
MsgBox "ce fichier """ & Fichier & """ n'est pas listé dans la plage """ & _
Rg.Address & """."
End If
End If
Next
End Sub
'---------------------------------

--
MichD
--------------------------------------------


"Alfred WALLACE" a écrit dans le message de groupe de discussion :

Bonjour,
est-il possible de parcourir une arborescence, et, pour
chaque fichier dont l'extention est ".lnk", donc, pour les fichiers de
type raccourcis , je modifie la propriété "Cible" et "Démarrer dans".

j'ai dans ma feuille, dans la colonne A la chaine à remplacer, et dans
la
colonne B, la nouvelle valeur de la chaine A.

Merci pour votre aide.

José
Avatar
michdenis
Une information supplémentaire pour que tu puisses t'y retrouver :

Dans la procédure, j'utilise des objets qui n'appartiennent pas au modèle objet d'Excel
comme : Dim WshShell As Object et Dim ObjShell As Object

D'où proviennent-ils ?

Set WshShell = CreateObject("WScript.Shell")

Cette variable fait référence à la bibliothèque suivante :
Nom de la référence à ajouter = "Windows Script Host Object Model"
Nom de la bibliothèque = IWshRuntimeLibrary (Windows7 64 bits)
Nom du fichier = "C:WindowsSysWOW64wshom.ocx"

Comme cette bibliothèque est déjà présente dans Windows, on peut
créer directement créer une instance de la bibliothèque seulement par :
Set WshShell = CreateObject("WScript.Shell") sans devoir ajouter la
référence au projet VBA.

Si tu veux voir les objets que contient cette bibliothèque, ajoute la référence
et ouvre l'explorateur d'objets : Raccourci = F2
Dans la liste déroulante : Toutes les bibliothèques, tu choisis la bibliothèque
que tu viens d'ajouter "IWshRuntimeLibrary" (elle a probablement un autre
nom si tu as Windows 32 bits ?? ) et dans le bas de la fenêtre, tous les objets,
méthodes et propriétés s'afficheront.

Si tu prends la peine d'ajouter la référence, tu pourras déclarer ta variable de cette manière :
Dim WshShell As New WshShell
et supprimer la ligne de code : Set WshShell = CreateObject("WScript.Shell")

Le principe est le même pour l'autre bibliothèque :

Set ObjShell = CreateObject("Shell.Application")
Nom de la Référence à ajouter = "Microsoft Shell Controls And Automation"
Nom de la bibliothèque = "Shell32"
Location = "C:WindowsSysWOW64shell32.dll"

Voilà.


--
MichD
--------------------------------------------


"michdenis" a écrit dans le message de groupe de discussion : i2uf9m$q9m$
Bonjour,

Regarde ce qui suit :

Tu dois adapter certains noms d'objets propres à ton application.
+
Tu dois ajouter un bout de code, car ta question n'était pas précise sur le sujet

J'ai pris pour acquis que les noms des anciens fichiers
étaient en A:A et les noms des nouveaux fichiers étaient en B:B

Le nom du raccourci n'est pas modifié, mais pointe sur ton nouveau fichier !
'---------------------------------
Sub Modifier_Fichier_Raccourci()
Dim ObjShell As Object, ObjFolder As Object
Dim WshShell As Object, Lien As Object
Dim Chemin As String, Fichier As String
Dim Raccourci As String, Temp As String
Dim X As Variant, CheminTemp As String
Dim Rg As Range

'Emplacement du répertoire où sont tes fichiers
Chemin = "c:"

'Liste de tes fichiers en A:A
'Liste des nouveaux fichiers en B:B
With Worksheets("Sheet1") 'nom feuille à modifier
'Plage à adapter
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With

'Création de l'instance
Set WshShell = CreateObject("WScript.Shell")
Set ObjShell = CreateObject("Shell.Application")
For Each ObjFolder In ObjShell.Namespace("c:").Items
If ObjFolder.IsLink Then
'Récupérer chemin et fichier des raccourci
Raccourci = ObjFolder.Path
'Objet raccourci lui-même (objet)
Set Lien = WshShell.createShortcut(Raccourci)
'Extraction du nom du fichier sur lequel pointe le raccourci
Temp = Split(Lien.TargetPath, "")(UBound(Split(Lien.TargetPath, "")))
'Vérifier si ce fichier est dans la plage Rg
X = Application.Match(Temp, Rg, 0)
If Not IsError(X) Then
'Extraction du chemin où est ce raccourci
CheminTemp = Replace(Lien.TargetPath, Temp, Rg(X, 1).Offset(, 1).Value)

'**************************
'Si tu veux substituer une partie de la chaîne du chemin
'Par autre chose, tu peux utiliser ceci : ancien et nouveau à définir
'CheminTemp = Application.WorksheetFunction.Substitute(CheminTemp, "Ancien", "Nouveau")
'**************************

'vérifier si l'extension du fichier existe... tu choisis l'extension de ton choix
If LCase(Right(CheminTemp, 5)) = ".xlsx" Then
Else
'extension de ton choix si nécessaire
CheminTemp = CheminTemp & ".xlsx"
End If

'Redéfinir le raccourci avec le nouveau nom fichier est le nouveau chemin
Lien.TargetPath = CheminTemp
Lien.WindowStyle = 1
Lien.IconLocation = "Excel.exe, 0"
Lien.Description = "Pour le plaisir" 'Optionnel
Lien.Hotkey = "CTRL+ALT+M" 'Optionnel
Lien.WorkingDirectory = Chemin
Lien.Save
Else
Err = 0
MsgBox "ce fichier """ & Fichier & """ n'est pas listé dans la plage """ & _
Rg.Address & """."
End If
End If
Next
End Sub
'---------------------------------

--
MichD
--------------------------------------------


"Alfred WALLACE" a écrit dans le message de groupe de discussion :

Bonjour,
est-il possible de parcourir une arborescence, et, pour
chaque fichier dont l'extention est ".lnk", donc, pour les fichiers de
type raccourcis , je modifie la propriété "Cible" et "Démarrer dans".

j'ai dans ma feuille, dans la colonne A la chaine à remplacer, et dans
la
colonne B, la nouvelle valeur de la chaine A.

Merci pour votre aide.

José
Avatar
michdenis
Une correction à apporter à cette ligne de code de la procédure :
For Each ObjFolder In ObjShell.Namespace("c:").Items

Évidemment, il faut remplacer "c:" par le nom de la variable Chemin
comme ceci :
For Each ObjFolder In ObjShell.Namespace(Chemin).Items
Avatar
Alfred WALLACE
Bonjour MichDenis,
merci beaucoup pour ce code et tes explications.
je me rend compte à quel point je suis à des années lumière ...

J'avais oublié de préciser que, actuellement je suis sous W2000
et que je vais passer sous Vista 32bits... mais pas encore....

je vais essayer de faire tourner ton code plain d'informations.

cordialement
José