Créer des raccourcis à partir d'une liste d'url

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,
je vous explique mon probleme...
j'ai une feuille excel avec en colonne C une liste de lien vers des fichiers.

J'aimerais pouvoir creer une macro qui va me creer des raccourcis vers ces fichiers et les placer dans un dossier avec la particularité que j'aimerais que les raccourcis créés porte le nom présent dans la colonne E.

j'ai trouvé cette macro mais je n'arrive pas a la modifier:
Code:

1 2 3 4 5 6 7 8 9 10 Sub crée_raccourci() Set scrHst = CreateObject("WScript.Shell") emplacement = scrHst.SpecialFolders("Desktop\Test") Set raccourci = scrHst.CreateShortcut(emplacement & "\truc.lnk") raccourci.WorkingDirectory = emplacement raccourci.TargetPath = "c:\zaza.doc" raccourci.Save Set raccourci = Nothing Set scrHst = Nothing End Sub
il faudrait en fait que cette macro aille pointer vers la colonne C pour l'url et qu'elle crée des raccourcis portant le nom présent dans la colonne E ...

Je pense que la macro devrait donc boucler sur la colonne C et mettre la valeur de C dans TargetPath et que pour changer le nom je pense que c'est ici : crHst.CreateShortcut(emplacement & "\colonne E")
Pour boucler, ça devrait se rapprocher d'un truc du style :
Code:

1 2 3 4 For x = 1 To n Step 1 'récupère les cellules A1, A2, ..., An Cells(x, 1) = "Ligne " & x Next x
mais je n'y arrive pas...

quelqu'un peut il m'aider...je vous ai mis le fichier en pièce jointe

Je vous remercie d'avance

Bonjour à tous.
pas de réponse alors j'ai continué à creuser.
J'ai déniché le code suivant:
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 Option Explicit Sub CreateDesktopShortcuts() Dim wSHELL As Object, Shortcut As Object, deskPATH As String Dim MyList As Range, MyFldr As Range Set MyList = Range("A:A").SpecialCells(xlConstants) Set wSHELL = CreateObject("WScript.Shell") deskPATH = wSHELL.SpecialFolders("C:\Users\BHI\Desktop\Test") For Each MyFldr In MyList If Len(Dir(MyFldr, vbDirectory)) > 0 Then Set Shortcut = wSHELL.CreateShortCut(deskPATH & "\" & MyFldr.Offset(, 1).Text & ".lnk") With Shortcut .TargetPath = MyFldr.Text .Save End With Else MyFldr.Interior.ColorIndex = 3 End If Next MyFldr Set wSHELL = Nothing End Sub
J'ai depuis modifié mon fichier qui se présente maintenant en 3 colonnes:
A: url des fichiers dont je veux créer le raccourci
B: nom du raccourci que je veux créer
C: emplacement du raccourci que je veux creer.

donc ca

Code:

Set MyList = Range("A:A").SpecialCells(xlConstants)

je pense que je dois le laisser comme ca

je dois certainement créer une variable

Code:

dim Empalcement

pour changer ca:

Code:

deskPATH = wSHELL.SpecialFolders("C:\Users\BHI\Desktop\Test")

mais je ne sais pas trop bien comment

et pour le nom aucune idée...

quelqu'un peut il m'aider?

merci d'avance

Pour ton premier code avec ton premier fichier

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub LinkCreate()
Dim ScrHst As Object, Raccourci As Object
Dim LastLig As Long, i As Long
Dim Emplacement As String
 
Set ScrHst = CreateObject("WScript.Shell")
Emplacement = ScrHst.SpecialFolders("Desktop") & "\Test"
LastLig = Feuil1.Cells(Feuil1.Rows.Count, 3).End(xlUp).Row
For i = 2 To LastLig
    Set Raccourci = ScrHst.CreateShortcut(Emplacement & "\" & Feuil1.Range("E" & i) & ".lnk")
    With Raccourci
        .WorkingDirectory = Emplacement
        .TargetPath = Feuil1.Range("C" & i)
        .Save
    End With
Next i
Set Raccourci = Nothing
Set ScrHst = Nothing
End Sub

18/12/2013, 20h10
bernardh

1 pièce(s) jointe(s)

@mercatog

merci bcp ça marche nickel avec le code que tu m'as donné.
tu sais comment je pourrais faire pour que mes raccourcis soient créés dans un dossier dont l'url est présente dans une colonne de ce même fichier excel (colonne K par exemple)
j'ai mis un nouveau fichier reprenant les dossiers de destination des raccourcis (en colonne K)

merci d'avance!!!!!!!

Sur ton fichier le chemin est en colonne J

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub LinkCreate()
Dim ScrHst As Object, Raccourci As Object
Dim LastLig As Long, i As Long
Dim Emplacement As String
 
Set ScrHst = CreateObject("WScript.Shell")
LastLig = Feuil1.Cells(Feuil1.Rows.Count, 3).End(xlUp).Row
For i = 2 To LastLig
    Emplacement = Feuil1.Range("J" & i)
    Set Raccourci = ScrHst.CreateShortcut(Emplacement & "\" & Feuil1.Range("E" & i) & ".lnk")
    With Raccourci
        .WorkingDirectory = Emplacement
        .TargetPath = Feuil1.Range("C" & i)
        .Save
    End With
Next i
Set Raccourci = Nothing
Set ScrHst = Nothing
End Sub