Ouvrir un raccourci via VBA

Bonjour à tous,

Tout d'abord j'espère qu'aucun fil n'ayant le même sujet n'a été créer, je n'ai rien trouvé.

Bien, je vous explique la situation, j'aimerai savoir si il est possible d'ouvrir un raccourci de fichier avec VBA, j'ai réussis à ouvrir des fichiers, des dossiers, mais des raccourcis, j'ai beau essayé, j'ai beau cherché, je ne trouve pas grand chose à ce sujet.. (Peut être un soucis de mot clé).

Codes testé :

Code:

---

1 2 3 4 5 6 7

Sub Achats()   Workbooks.Open Filename:= _ "P:\090-QUALITE & SECURITE\080-REVUES DE DIRECTION\Processus indicateurs\Achats.xlsm" _ , UpdateLinks:=0   End Sub

---

Second code testé :

Code:

---

1 2 3 4 5 6 7

Sub Test() Dim Fichier As String Fichier = "P:\090-QUALITE & SECURITE\080-REVUES DE DIRECTION\Processus indicateurs\" & "Achats.xlsm" Fichier = "cmd /c " & """" & Fichier & """" Call Shell(Fichier, vbHide) Workbooks.Open Fichier End Sub

---

Ce dernier à été trouvé sur internet, mais je débute et j'ai pas réussis à le faire s'adapter à mon problème … Si l'un d'entre vous pourrais m'aiguiller sur les erreurs que j'ai pu effectuer sur ces codes, ou si carrément je prend le mauvais chemin ou si c'est carrément pas possible peut être..

Merci d'avance du temps que vous allez passer à me repondre,

Cordialement,

Axel.

Bonjour,

Pourquoi "ouvrir un raccourci" et pas ouvrir le fichier directement?

Sinon, voici :

Code:

---

1 2 3 4 5 6

Sub Test() Dim Fichier As String Fichier = "C:\MonFichier - raccourci.lnk" Fichier = "cmd /c " & """" & Fichier & """" Call Shell(Fichier, vbHide) End Sub

---

J'ai rentré ton code et on voit bien que ca mouline mais rien ne se passe, pourtant quand je lance avec F8, le fichier s'appelle bien comme il faut mais il ne l'ouvre pas c'est normal ?

Citation:

---

Pourquoi "ouvrir un raccourci" et pas ouvrir le fichier directement?

---

Alors en gros, les fichiers sont dans un dossier bien particulier qui est fixe. Ce que je souhaites faire c'est créer des sous-dossier pour y mettre les raccourcis

Chaque fichier correspond à un processus de l'entreprise,
Chaque dossier correspondrait à un responsable de processus

Les processus ne changeront jamais d'endroit par conséquent ils ont un emplacement fixe, par contre les responsable de processus peuvent se décharger le travail, et donner un processus à quelqu'un d'autre, pour cela il doit deplacer le processus de son dossier à celui d'un autre collègue. j'ai 4 responsables de processus et 11 fichiers qu'ils se partagent, voila pourquoi les raccourcis. Cependant, si tu as compris ce que je voulais dire et que tu as une meilleure solution je suis preneur !

PS : Il faut aussi que chaque amélioration soit enregistrée bien entendu sur le fichier source ce qui explique qu'on ne peut pas créer une simple copie

PS 2 : Je précise également que ces fichiers se trouvent sur un reseau d'entreprise et qu'avec l'invité de commande (En enlevant le "VbHide" à la fin) j'ai pas réussis à y accéder

Merci

Citation:

---

J'ai rentré ton code et on voit bien que ca mouline mais rien ne se passe

---

Peux-tu nous copier/coller ton code?

Oui biensur alors j'ai testé plusieurs codes mais surement pas les bons ^^

N°1

Code:

---

1 2 3 4 5 6

Sub Test() Dim Fichier As String Fichier = "P:\090-QUALITE & SECURITE\080-REVUES DE DIRECTION\Processus indicateurs\Achats.xlsm - raccourci.lnk" Fichier = "cmd /p " & """" & Fichier & """" Call Shell(Fichier) End Sub

---

N°2

Code:

---

1 2 3 4 5 6

Sub Test() Dim Fichier As String Fichier = "P:\Achats.xlsm - raccourci.lnk" Fichier = "cmd /p " & """" & Fichier & """" Call Shell(Fichier) End Sub

---

N°3

Code:

---

1 2 3 4 5 6

Sub Test() Dim Fichier As String Fichier = "P:\090-QUALITE & SECURITE\080-REVUES DE DIRECTION\Processus indicateurs\Achats.xlsm - raccourci.lnk" Fichier = "cmd /c " & """" & Fichier & """" Call Shell(Fichier) End Sub

---

N°4

Code:

---

1 2 3 4 5 6

Sub Test() Dim Fichier As String Fichier = "P:\Achats.xlsm - raccourci.lnk" Fichier = "cmd /c " & """" & Fichier & """" Call Shell(Fichier) End Sub

---

1- tu oublies : cmd /p. ça ne veut rien dire.
Regarde ici pour les commandes "DOS" : https://stackoverflow.com/questions/...oes-cmd-c-mean

2- la bonne syntaxe est plus celle-ci :

Code:

---

1 2 3 4 5 6

Sub Test() Dim Fichier As String Fichier = "P:\090-QUALITE & SECURITE\080-REVUES DE DIRECTION\Processus indicateurs\Achats.xlsm - raccourci.lnk" Fichier = "cmd /c " & """" & Fichier & """" Call Shell(Fichier) End Sub

---

à vérifier :
- l'accès au réseau,
- l'accès au fichier (l'ouvrir manuellement via le raccourci)
- le nom EXACT du raccourci.

J'ai branché le cable au lieu de passer par la wifi, j'ai re copier coller le chemin, j'ai copier coller le nom du fichier, le raccourcis s'ouvre correctement manuellement pourtant le résultat reste le même => Rien …

Code :

Code:

---

1 2 3 4 5 6

Sub Test() Dim Fichier As String Fichier = "P:\090-QUALITE & SECURITE\080-REVUES DE DIRECTION\Processus indicateurs\Achats.xlsm - raccourci.lnk" Fichier = "cmd /c " & """" & Fichier & """" Call Shell(Fichier) End Sub

---

Alors, je ne sais pas t'aider davantage…

As-tu essayé avec vbHide?

Code:

---

Call Shell(Fichier, vbHide)

---

Je viens de redémarrer Excel, et mon ordinateur par sécurité histoire d'être sur de pas être parasité par quoi que ce soit, j'ai rajouter le vbHide et le résultat est le même.

Merci quand même du temps passé à essayer de trouver une solution

Salut,

A priori, si j'ai bien compris, tu sais ou se trouvent les raccourcis, mais pas les fichiers.

Cette procédure, trouvée ici https://www.developpez.net/forums/d3...i/#post2353804 , et réarrangée pour toi, va lister, dans une collection, les chemins de tes fichiers par rapport au nom du raccourci.

ATTENTION : Nécessite d'activer la référence "Microsoft Shell Controls and Automation"
Dans VBE : Outils/références

Le test suivant va lister tous les raccourcis trouvés dans le bureau et va ouvrir le classeur dont le raccourci a pour nom : "raccourci_Classeur"

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30

Sub Test() 'Nécessite d'activer la référence '"Microsoft Shell Controls and Automation" Dim liste As New Collection, v As Variant Set liste = ListeFichiersLinks("C:\Users\" & Environ("UserName") & "\Desktop") MsgBox liste.Item("raccourci_Classeur").GetLink.Path ' For Each v In liste ' Debug.Print v.GetLink.Path ' Next Workbooks.Open liste.Item("raccourci_Classeur").GetLink.Path End Sub   Private Function ListeFichiersLinks(Chemin As String) As Collection Dim objShell As Shell Dim itFile As FolderItem Dim objFolder As Folder Dim result As New Collection Dim i As Integer   Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.Namespace(Chemin)   For Each itFile In objFolder.Items If itFile.IsLink = True Then result.Add itFile, CStr(itFile) Next itFile Set ListeFichiersLinks = result Set result = Nothing Set objShell = Nothing Set objFolder = Nothing End Function

---

Je t'ai également laissé le code de la boucle sur les éléments de la collection dans la sub test()

Bonjour,

Si je connais l'emplacement des fichiers originaux et des raccourcis.

Je cherche juste deux façon de les ouvrir différente une version fixe ou ils pourront ouvrir processus par processus et une version mobile ou ils pourront ouvrir responsable de processus par responsable de processus

Autre chose je ne sais pas si cela pourrait être plus simple à la rigueur mais je peux placer les fichiers dans un dossier et dire d'ouvrir tout ce qu'il se trouve dans le dossier ? raccourcis ou pas ? je sais pas si ca pourrait fonctionner ou même si c'est possible.

Je vais essayer de regarder ton code et l'adapter voir si j'arrive a faire quelque chose merci

Je ne comprend pas comment cette fonction fonctionne (Sans mauvais jeu de mot)

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

Private Function ListeFichiersLinks(Chemin As String) As Collection Dim objShell As Shell Dim itFile As FolderItem Dim objFolder As Folder Dim result As New Collection Dim i As Integer   Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.Namespace(Chemin)   For Each itFile In objFolder.Items If itFile.IsLink = True Then result.Add itFile, CStr(itFile) Next itFile Set ListeFichiersLinks = result Set result = Nothing Set objShell = Nothing Set objFolder = Nothing End Function

---

Tu demandes de trouver le chemin avec la ligne

Code:

---

Set objFolder = objShell.Namespace(Chemin)

---

mais à aucun moment il a été défini c'est normal ?

Quand je teste, ca bloque ici :

Code:

---

For Each itFile In objFolder.Items

---

Et me dit : "Variable objet ou variable de bloc with non définie"

Du coup on a objFolder qui n'a pas de chemin et itFile qui est définie comme étant un FilderItem mais lui a rien attribué.

J'ai tenté de déclarer une variable chemin as string et rentré le chemin mais ca plante toujours par contre le itFolder je sais pas du tout quoi faire pour lui

Cordialement,

Le plus simple pour boucler sur un répertoire et en rechercher tous les fichiers .xls, .xlsx, .xlsm, etc... est d'utiliser la fonction Dir() :
https://docs.microsoft.com/fr-fr/off...p/dir-function

Exemple :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Sub BoucleDir() Dim Chemin As String, Fichier As String Chemin = "C:\Users\" & Environ("UserName") & "\Desktop\" Fichier = Dir(Chemin & "*.xls*") If Fichier <> vbNullString Then Debug.Print Fichier Do Fichier = Dir Debug.Print Fichier Loop While Fichier <> vbNullString End If End Sub

---

Citation:

---

mais à aucun moment il a été défini c'est normal ?

---

Il a été défini dans l'appel de la fonction :

Code:

---

1 2 3 4 5

Sub Test() 'Nécessite d'activer la référence '"Microsoft Shell Controls and Automation" Dim liste As New Collection, v As Variant Set liste = ListeFichiersLinks("C:\Users\" & Environ("UserName") & "\Desktop") 'ICI, le chemin est : "C:\Users\" & Environ("UserName") & "\Desktop"

---

La boucle DIR permettrait d'ouvrir également les fichiers raccourcis ?

Citation:

---

Envoyé par Patate3181

La boucle DIR permettrait d'ouvrir également les fichiers raccourcis ?

---

C'est en essayant que l'on trouve…

Dans un répertoire : C:\Test\ insère 2-3 raccourcis vers des fichiers Excel, puis lance :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Sub BoucleDir() Dim Chemin As String, Fichier As String Chemin = "C:\Test\" Fichier = Dir(Chemin & "*.lnk") If Fichier <> vbNullString Then Workbooks.Open Chemin & Fichier Do Fichier = Dir Workbooks.Open Chemin & Fichier Loop While Fichier <> vbNullString End If End Sub

---

Bon après pleins de test, je me suis aperçu que je problème venait du chemin du fichier, ce que je ne comprend pas soit dit en passant, j'ai comparé un copier coller et une version écrite à la main, les deux sont identiques mais le copier coller ne fonctionne pas et l'autre si... Bref du coup j'arrive à ouvrir les fichier.

Cependant ton code ne s'arrête pas étrangement quand il y n'y a plus rien, il me dit qu'il trouve pas un fichier au nom vide dans le répertoire.

Du coup j'ai fais d'autres tests, j'ai tenté de :
- Remplacer le vbNullString, par "" ,
- Remplacer le While par Until (Pour avoir la formulation jusqu'à mais c'était peu concluant...)
- Deplacer le While
- Supprimer le If

Et le tout en croisé j'ai fais un test de tout avec tous les autres.

Les seuls résultats que j'ai pu avoir sont :
- Rien ca n'a rien changé, ca me dit toujours qu'il cherche un fichier vide
- N'ouvre que 2 fichier sur les 4 présents dans le répertoire (Testé sur d'autres répertoires de 4 avec des fichiers différents)

Code actuel :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Sub BoucleDir() Dim Chemin As String, Fichier As String Chemin = "\\frpc-srv2\DATA_SAP\090-QUALITE & SECURITE\080-REVUES DE DIRECTION\Processus indicateurs\PDL\" Fichier = Dir(Chemin & "*.lnk") If Fichier <> "" Then Workbooks.Open Chemin & Fichier Do Fichier = Dir Workbooks.Open Chemin & Fichier Loop While Fichier <> "" End If End Sub

---

Mea Culpa.
Mais bon, essaye d'adapter...

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Sub BoucleDir() Dim Chemin As String, Fichier As String Chemin = "\\frpc-srv2\DATA_SAP\090-QUALITE & SECURITE\080-REVUES DE DIRECTION\Processus indicateurs\PDL\" Fichier = Dir(Chemin & "*.lnk") If Fichier <> "" Then Do Workbooks.Open Chemin & Fichier Fichier = Dir Loop While Fichier <> "" End If End Sub

---

Ca fonctionne c'est exactement ce que je souhaitais merci beaucoup Pijaku pour ta patience et tes résultats !