Créer un raccourci sur tous les PC du réseau

[Guiv]

Bonjour à tous,

En cherchant sur le forum, j'ai trouvé à plusieurs reprises cet excellent code qui permet de créer un raccourci sur le bureau:

Sub CreerRaccourci()
Dim Raccourci As Object
   With CreateObject("WScript.Shell")
        Set Raccourci = .CreateShortcut(.SpecialFolders("Desktop") & "\" & _
                    ActiveWorkbook.Name & ".lnk")
   End With
   Raccourci.TargetPath = ActiveWorkbook.FullName
   Raccourci.Save
   Set Raccourci = Nothing
End Sub

Ca fonctionne au poil, et voici ma question:
Nous avons un fichier Truc2008.xls sur le serveur d'un petit réseau (7 PC). Chaque PC a un raccourci vers Truc2008.xls sur son bureau.
Dès le 1er janvier 2009, le premier qui ouvrira Truc2008.xls devra créer Truc2009.xls qui ira se placer dans le même répertoire que Truc2008.xls sur le serveur. Jusque-là tout marche bien, c'est automatique.
En ajoutant le code ci-dessus à la procédure qui crée le fichier 2009, un raccourci sera créé sur le bureau du PC d'où sera lancé la procédure.

Comment faire pour qu'il y ait un raccourci sur tous les PC du réseau?
Et si en plus on peut supprimer les raccourcis vers Truc2008, c'est génial!!!

Merci d'avance de vos conseils.

Guiv

 

[tototiti2008]

Re : Créer un raccourci sur tous les PC du réseau

Bonjour Guiv,

donc tu veux une procédure VBA qui aille sur les bureaux de tous les utilisateurs du réseau pour modifier ou supprimer un raccourcis ?
Je crois que si on pouvait faire ça, on serait tous noyés sous les virus...

 

[job75]

Re : Créer un raccourci sur tous les PC du réseau

Bonjour Guiv, Tototiti,

Je ne suis pas spécialiste des réseaux, mais il me semble qu'on pourrait mettre dans le ThisWorbook du fichier Truc2008, puis Truc2009 etc... la macro suivante (à tester) :

Private Sub Workbook_Open()
Dim fichier As String
fichier = "Truc" & Year(Date)
If ActiveWorkbook.Name = fichier & ".xls" Then Exit Sub
Dim Raccourci As Object
Set Raccourci = CreateObject("WScript.Shell").CreateShortcut(fichier & ".lnk") [COLOR="Red"]'crée le nouveau raccourci dans le dossier en cours du PC[/COLOR]
Raccourci.TargetPath = ActiveWorkbook.Path & "\" & fichier & ".xls"
Raccourci.Save
Set Raccourci = Nothing
Kill "Truc" & Year(Date) - 1 & ".lnk" [COLOR="Red"]'supprime le raccourci de l'année précédente[/COLOR]
End Sub

A+

 

[job75]

Re : Créer un raccourci sur tous les PC du réseau

Re,

La macro précédente fonctionne correctement si le raccourci est dans le dossier en cours et si son nom n'a pas été modifié.

Mais ce n'est pas forcément le cas.

Il faudrait pouvoir déterminer le chemin d'accès et le nom d'un raccourci quand on l'utilise.

Quelqu'un a-t-il une idée ?

A+

 

[Guiv]

Re : Créer un raccourci sur tous les PC du réseau

Bonjour tototiti, job75 et les autres,

Merci de vous être penchés sur mon problème.
Je n'ai pas beaucoup le temps là, mais j'essaie de regarder la proposition de job75 ce week-end...
Je n'y connais pas grand-chose en réseau non plus, peut-être est-il possible d'utiliser les adresses IP??? Ou créer dans le code que j'ai cité plusieurs objets "raccourci 1, 2, 3 etc" avec des chemins différents pour chaque PC???
A bientôt

Guiv

 

[job75]

Re : Créer un raccourci sur tous les PC du réseau

Bonjour Guiv, le forum,

J'ai eu beau chercher, je n'ai rien trouvé pour résoudre le problème du chemin d'accès et du nom du raccourci.

Pour le nouveau raccourci, le mieux est donc de le placer dans un SpecialFolders (par exemple "MyDocuments" ou "Desktop").

Pour l'ancien raccourci, il sera supprimé s'il n'a pas été déplacé ou renommé.

Private Sub Workbook_Open()
Dim fichier As String
fichier = "Truc" & Year(Date)
If ActiveWorkbook.Name = fichier & ".xls" Then Exit Sub
Dim Chemin As String, Raccourci As Object
With CreateObject("WScript.Shell")
Chemin = .SpecialFolders("MyDocuments") & "\"
Set Raccourci = .CreateShortcut(Chemin & fichier & ".lnk") 'crée le raccourci sur le PC
End With
Raccourci.TargetPath = ActiveWorkbook.Path & "\" & fichier & ".xls"
Raccourci.Save
Set Raccourci = Nothing
On Error Resume Next
Kill Chemin & "Truc" & Year(Date) - 1 & ".lnk" 'supprime le raccourci de l'année précédente
End Sub

A+