XL 2013 Une macro pour mettre le contenu (documents) de plusieurs liens hypertexte dans un dossier

[mounir907]

J’ai un fichier XL qui contient environ 1000 liens hypertextes, et je voudrais enregistrer dans un folder 50 ou 60 documents à la fois (qui se trouvent dans les links).

SVP, Pourriez-vous m’aider à créer une macro pour sélectionner les liens et mettre leur contenu (documents) dans un dossier.

Merci d’avance

 

[sousou]

Bonjour
Il serait intéressant de savoir vers quoi pointe ces liens

 

[mounir907]

Bonjour Sousou,

Je voudrais déplacer ces liens (documents) vers un notre dossier sur mon PC. par exemple, je sélectionne 30 ou 40 lignes et je donne instruction à XL de déplacer les fichiers qui se trouvent dans les liens sélectionnés et les mettre dans un autre dossier sur mon PC (mes documents).. est-ce que cela est possible? merci d'avance

 

[sousou]

Bonjour
avec ce code adapté à ton arborescence tu devrais y arriver
Sub deb()
chemin = ThisWorkbook.Path & "\"
For Each i In Selection
Set h = ActiveSheet.Hyperlinks(i.Value)
fichier = chemin & h.Address
Call deplace(fichier)
Next
End Sub


Sub deplace(fichier)
dest = "C:\Documents and Settings\HP_Propriétaire\Bureau\exceldownload\dest\"
Set fso = CreateObject("scripting.filesystemobject")
fso.movefile fichier, dest
End Sub

 

[mounir907]

Bonjour Sousou,

Merci bcp pour ces ces codes, mais ça marche pas. J'ai essayé les 2 codes , néanmoins, je n'ai pas eu de résultat. Est-il possible de créer un bouton sur XL pour déplacer ou télécharger les fichiers des liens sélectionnés, et les mettre dans un folder (C:\Downloaded-links). Merci d'avance

 

[sousou]

Bonjour
Étonnant, essai d'envoyer un morceau de ton fichier.
Le principe , tu sélectionnes les liens que tu veux transférer, et tu lance la macro deb
en aynat pris soin de modifier ainsi dest="c:\downloaded-links\"

 

[mounir907]

Voir le fichier ci-joint

 

[sousou]

Essai ainsi.


Sub deb()
chemin = ThisWorkbook.Path & "\"
For Each i In Selection
Set h = ActiveSheet.Hyperlinks(i.Value)
fichier = chemin & h.Address
'MsgBox Len(h.Address) & " : " & InStrRev(h.Address, "\")
f = Right(h.Address, Len(h.Address) - InStrRev(h.Address, "\"))
'MsgBox f

Call deplace(f)
Next
End Sub


Sub deplace(fichier)
dest = "C:\Documents and Settings\HP_Propriétaire\Bureau\exceldownload\dest\"
Set fso = CreateObject("scripting.filesystemobject")
fso.movefile fichier, dest
End Sub

 

[mounir907]

Ça ne marche pas toujours (voir les messages d’erreurs ci-joint).

Pourrais-tu créer un bouton (DOWNLOAD) dans le fichier XL ci-joint

Merci d'avance

 

[sousou]

Un probleme d'arborescence
Il faudrait me préciser un exemple fichier source (chemin complet) et fichier destination (chemin complet)
Par exemple pour le premier lien.

 

[mounir907]

Je n’ai pas de fichier source (chemin complet), car les chemins sont cachés par XL, il n y a que les titres qui apparaissent et qui renvoient vers des fichiers.

Concernant le fichier de destination, c’est : c:\downloaded-links\

En effet, j’ai une macro qui me donne les chemins complets mais ça bloque dans les cellules vides

Sub liens ()

Dim c As Range

For Each c In Sheets("Feuil1").Range("A1:A10").Cells

c.Offset(0, 1).Value = c.Hyperlinks(1).Address

Next

End Sub

 

[sousou]

bon je suis un peu perdu, essaie comme cela pour moi ca fonctionne
Sub deb()
chemin = ThisWorkbook.Path & "\"
For Each i In Selection
If i <> "" Then
Set h = ActiveSheet.Hyperlinks(i.Value)
fichier = h.Address
'MsgBox fichier
Call deplace(f)
End If
Next
End Sub


Sub deplace(fichier)
dest = "c:\downloaded-links\"
Set fso = CreateObject("scripting.filesystemobject")
'MsgBox fichier & " " & dest 'si ca ne fonctionne pas décommente cette ligne et envoi l'image
fso.movefile fichier, dest
End Sub