Copier les fichiers sélectionnés et les mettre dans un dossiers

[mounir907]

Bonjour,

J’ai un bouton de commande XL pour ouvrir tous fichiers sélectionnés (liens hypertexte).

Je voudrais que ces fichiers soient enregistrés automatiquement dans un dossier (EX : D:\SELECTED FILES).

les étapes à suivre :


- Sélectionner les liens hypertextes et cliquer sur le bouton de commande

- La macro affectée au bouton de commande doit :


a- Faire une copie de tous les fichiers qui se trouvent dans les liens hypertextes

b- Copier ces fichiers dans un dossier sur le PC (EX : D:\SELECTED FILES).

c- Après avoir copié ces fichiers dans le dossier, ce dernier s’ouvre automatiquement.

J'espère avoir été clair (voir ci-joint un exemple de fichier + macro)



Merci d'avance pour votre aide

 

[mounir907]

Quelqu'un peut-il m'aider ?

 

[job75]

Bonjour mounir907,

Essayez cette macro :

Sub Copier()
Dim dossier$, h As Hyperlink, fichier$, nom$
dossier = "D:\SELECTED FILES\" 'à adapter
On Error Resume Next
For Each h In ActiveSheet.Hyperlinks
    fichier = h.Address
    If Not fichier Like "?:\*" Then fichier = ThisWorkbook.Path & "\" & fichier
    nom = Mid(fichier, InStrRev(fichier, "\") + 1)
    FileCopy fichier, dossier & nom 'copie
Next
Application.Dialogs(xlDialogOpen).Show dossier & "*"
End Sub

A+

 

[job75]

Re,

Application.Dialogs n'est pas bien fameux, il vaut mieux utiliser la fonction Shell pour ouvrir le dossier :

Sub Copier()
Dim dossier$, h As Hyperlink, fichier$, nom$
dossier = "D:\SELECTED FILES\" 'à adapter
On Error Resume Next
For Each h In ActiveSheet.Hyperlinks
    fichier = h.Address
    If Not fichier Like "?:\*" Then fichier = ThisWorkbook.Path & "\" & fichier
    nom = Mid(fichier, InStrRev(fichier, "\") + 1)
    FileCopy fichier, dossier & nom 'copie
Next
Shell Environ("WINDIR") & "\explorer.exe " & dossier, vbNormalFocus
End Sub

A+

 

[mounir907]

Job75 merci bcp pour la macro.
Elle fonctionne très bien mais je voudrais juste que la macro copie seulement les fichiers ou les lignes sélectionnés et pas tout les fichiers.
EX: J'ai des fichiers (liens) de 1 à 12, quand je sélectionne les liens de 3 à 6 et je clique sur le bouton; je veux trouver les fichiers 3-4-5-6 et pas les 12 fichiers.
Merci d'avance

 

[job75]

Bonjour mounir907,

Bien sûr vous pouvez toujours dans la macro remplacer ActiveSheet par Selection mais quel intérêt ?

A+

 

[mounir907]

Merci bcp Job75 .. ça marche trés trés bien ..
Le but de cette macro est de pouvoir copier seulement les liens sélectionnés. ça fonctionne comme une BDD.
Merci encore et bonne journée

 

[mounir907]

Bonjour Job75,

Est-il possible de remplacer le dossier "D:\SELECTED FILES\" en faisant appel à la fenêtre WINDOWS (Enregistrer sous).

Merci d'avance

 

[job75]

Bonsoir mounir907,

Une solution avec Application.FileDialog :

Sub Copier()
Dim dossier As FileDialog, h As Hyperlink, fichier$, nom$
Set dossier = Application.FileDialog(msoFileDialogFolderPicker)
If dossier.Show = False Then Exit Sub 'Annuler
On Error Resume Next
For Each h In ActiveSheet.Hyperlinks 'Selection.Hyperlinks
    fichier = h.Address
    If Not fichier Like "?:\*" Then fichier = ThisWorkbook.Path & "\" & fichier
    nom = Mid(fichier, InStrRev(fichier, "\"))
    FileCopy fichier, dossier.SelectedItems(1) & nom 'copie
Next
Shell Environ("WINDIR") & "\explorer.exe " & dossier.SelectedItems(1), vbNormalFocus
End Sub

A+

 

[mounir907]

Merci bcp Job75 .. ça marche trés bien .. bonne journée