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

mounir907

XLDnaute Nouveau
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
 

mounir907

XLDnaute Nouveau
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

XLDnaute Barbatruc
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
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

XLDnaute Nouveau
Ç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
 

Pièces jointes

  • Error msg-1.jpg
    Error msg-1.jpg
    17.2 KB · Affichages: 61
  • Error msg-2.jpg
    Error msg-2.jpg
    49.7 KB · Affichages: 61
  • Classeur1.xlsx
    105.9 KB · Affichages: 75

mounir907

XLDnaute Nouveau
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

XLDnaute Barbatruc
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
 

Discussions similaires

Statistiques des forums

Discussions
312 913
Messages
2 093 534
Membres
105 752
dernier inscrit
fred13340