comment copier le nom et l'adresse d'un raccourci

[Thomas]

Bonsoir le forum,

je cherche un moyen de scaner le bureau de Windows ou sont stockés les raccourcis,

en éffét mon but est de pouvoir l'orsque je réinstal vindows de pouvoir restituer le bureau tel qu'il etait avec les raccourcis internet ainsi que des raccourcis vers mes autres HDD.

pour ce faire j'ai pensé prendre cette macro que j'ai trouvé sur le site de veriti afin de créer mes raccourcis

Option Explicit


'placer un raccourci
Sub Raccourci_URL()


Dim Objet, Lien, Bureau
Set Objet = CreateObject('WScript.Shell')
Bureau = Objet.SpecialFolders('Desktop')
Set Lien = Objet.CreateShortcut(Bureau & '\\Excel.lnk')
Lien.TargetPath = 'C:\\Program Files\\Microsoft Office\\Office10\\excel.exe'
Lien.Save
End Sub


ce que je souhaite c'est modifier la macri ci dessus en remplacant 'Excel' par une variable qui serait alimenté par une boucle qui pointerait dans la colonne 'A' et le 'C:\\Progam....' par une autre variable qui elle aussi serait alimenté par une boucle mais là vers la colonne 'B'

c'est pour cela que je m'adresse à vous pour savoir si quelqu'un sait comment peut on scanner le bureau afin de recupérer le nom du raccourci ainsi que l'adresse de celui ci (le nom en A et l'adresse en B)

ce serait vraiment gentil de m'aider.

D'avance merci

 

[Thomas®]

Re bonsoir le forum,

Je vous join la macro que j'ai modifier qui permet de créer des raccourcis à l'aide d'un tableau référensé.

pour info je suis sous XP avec office XP2002

D'avance merci
Thomas® [file name=raccourctomi.zip size=10167]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/raccourctomi.zip[/file]

 

[PascalXLD]

Re:comment copier le nom et l'adresse d'un raccour

Bonjour

Tu as quel Windows

Sous xp ce que tu demandes se trouve sous

C:\\Documents and Settings\\All Users\\Bureau

Là tu as tous les raccourcis qui seront sur le bureau quelque soit l'utilisateur
et

C:\\Documents and Settings\\Ton Login\\Bureau

Là tu auras tes raccourcis propres

Tu as juste a sauvegarder ces 2 répertoires pour retrouver tes raccourcis

Bon courage

 

[MichelXld]

Re:comment copier le nom et l'adresse d'un raccour

bonjour Thomas , bonjour Pascal

la solution proposée par Pascal est la mieux adaptée , mais juste pour le fun la macro ci dessous boucle sur tous les raccourcis du bureau pour en récupérer les infos

Sub informationsRaccourcisBureau()
'michelxld le 16.04.2005
'
'activer reference Microsoft Shell Controls and Automation 
'activer reference Microsoft Scripting Runtime
'
'testé avec excel2002 & WinXp
'
Const Cible = &H10 'Desktop
'
Dim objShell As Shell32.Shell
Dim objFolder As Shell32.Folder
Dim colItems As Shell32.FolderItems
Dim objItem As Shell32.FolderItem
Dim i As Integer
Dim Fso As Scripting.FileSystemObject
Dim FileItem As Scripting.File

Set objShell = CreateObject('Shell.Application'Â'Â')
Set objFolder = objShell.NameSpace(Cible)
Set colItems = objFolder.Items
Set Fso = CreateObject('Scripting.FileSystemObject'Â'Â')

For Each objItem In colItems
If objItem.IsLink Then
i = i + 1
Cells(i, 1) = objItem.Path
Cells(i, 2) = objItem.GetLink.Path
Cells(i, 3) = objFolder.GetDetailsOf(objItem, 14)

If Fso.FileExists(objItem.GetLink.Path) Then
Set FileItem = Fso.GetFile(objItem.GetLink.Path)
Cells(i, 4) = FileItem.Type
Cells(i, 5) = objItem.Name
End If

End If
Next
End Sub

bon week end
MichelXld


Edition :
j'avas oublié le nom du raccourci
Cells(i, 5) = objItem.Name

Message édité par: michelxld, à: 16/04/2005 11:32

 

[Thomas®]

Re:comment copier le nom et l'adresse d'un raccour

Bonjour Pascal76, MichelXld,

merci pour vos infos

MichelXld, ta macro est exactement ce que je cherché.

je sais qu'il y a des pro ici mais là :silly: je suis impressionné du nombre d'info que tu arrives à récupérer depuis les raccourcis du bureau!!!

là maintenant il ne me reste plus qu'a la modifier un peu (enfin essayer) afin qu'elle reponde à ma macro join dans mon poste.

ou alors modifier la 1ere macro?? je vais voir la moins galaire

dans tout les cas merci à vous
Thomas®

 

[Thomas®]

Re:comment copier le nom et l'adresse d'un raccour

Bonjour,

et merci pour vos reponse,

dans la reponse de MichelXld

j'ai tout ce qu'il me faut pour alimenter ma macro( celle que j'ai posté au debut) mais je suis obligé de modifier le resulta de la colonne A

(exemple : C:\\Documents and Settings\\doogy\\Bureau\\Excel.lnk)

avec une formule excel afin de n'avoir que

\\Excel.lnk

savez vous si il est possible de faire en sorte que la macro me donne directement le \\Excel.lnk car en passant par une formul excel je ne fait que lui dire tu me donne les 10 derniers caracteres mais ce n'est pas toujours 10!!


(exemple : C:\\Documents and Settings\\doogy\\Bureau\\Lecteur Windows Media.lnk)

cette adresse je l'obtient grace à cette partie du code de MichielXls

Cells(i, 1) = objItem.Path

penser vous qu'il est possible de créer une variabe qui serait egal a objItem.Path sans le C:\\Documents and Settings\\doogy\\Bureau

D'avance merci
Thomas

 

[MichelXld]

Re:comment copier le nom et l'adresse d'un raccour

bonjour Thomas , bonjour Pascal

j'espere que cette adaptation répondra à ta demande

Sub informationsRaccourcisBureau_V02()
'michelxld le 17.04.2005
'
'activer reference Microsoft Shell Controls and Automation
'activer reference Microsoft Scripting Runtime
'
'testé avec excel2002 & WinXp
'
Const Cible = &H10 'Desktop
'
Dim objShell As Shell32.Shell
Dim objFolder As Shell32.Folder
Dim colItems As Shell32.FolderItems
Dim objItem As Shell32.FolderItem
Dim i As Integer
Dim Fso As Scripting.FileSystemObject
Dim FileItem As Scripting.File
Dim Longueur As Integer, j As Integer

Set objShell = CreateObject('Shell.Application')
Set objFolder = objShell.NameSpace(Cible)
Set colItems = objFolder.Items
Set Fso = CreateObject('Scripting.FileSystemObject')

For Each objItem In colItems
If objItem.IsLink Then
i = i + 1
Cells(i, 1) = objItem.Path


'µµµµµµµµµµµµµµµµµµµµµµµµµ

Longueur = Len(objItem.Path)
j = Longueur
While Mid(objItem.Path, j, 1) <> '\\'
j = j - 1
Wend
Cells(i, 2) = Mid(objItem.Path, j + 1, Longueur - j)
'&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;&micro;

Cells(i, 3) = objItem.GetLink.Path
Cells(i, 4) = objFolder.GetDetailsOf(objItem, 14)

If Fso.FileExists(objItem.GetLink.Path) Then
Set FileItem = Fso.GetFile(objItem.GetLink.Path)
Cells(i, 5) = FileItem.Type
Cells(i, 6) = objItem.Name
End If

End If
Next
End Sub

bon apres midi
MichelXld