XL 2016 Macro chargement liste arborescence, copier coller fichiers

[Nermal64]

Bonjour,

Entrant dans le monde vba, j'ai quelques soucis sur des requêtes d'automatisation...
J'ai généré un listing arborescence/ nom_de_fichier de fichiers de formats divers (txt, pdf, etc...) présents dans des arborescences différentes.
Ces informations sont renseignées dans une feuille excel (ici Feuil2).
J'essaie de générer une macro vba procédant à l'automatisation du copier coller de ces fichiers vers un dossier cible via FileCopy, en bouclant sur la lecture de chaque ligne de ma feuille et copier coller vers une destination déjà existante, renseignée via box de dialogue.

J'ai malheureusement un retour d'erreur : Erreur d'exécution '52' : Nom ou numéro de fichier incorrect.
Mes recherches n'aboutissent pas....

Auriez vous une piste à m'indiquer pour résoudre mon problème s'il vous plait ?

Mille merci par avance.

Ci-dessous Macro et exemple de données présentes sur la feuil2

1. Macro :

Sub Transfert()

Dim objShell As Object, objFolder As Object, oFolderItem As Object, Fso As Object
Dim Source As String, Inter1 As String, Inter2 As String, Destination As String
Dim counter As Integer

counter = 1

'localiser arbrorescence de sauvegarde
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire de destination", &H1&)


Set oFolderItem = objFolder.Items.Item

'Sauvegarde dans un dossier
Inter1 = oFolderItem.Path
Destination = """" & Inter1 & """"


'feuille = sheet
'classeur = workbook
'classeur actif = activeworkbook


For Each s In ActiveWorkbook.Sheets
ActiveWorkbook.Sheets("Feuil2").Cells(counter, 1) = Inter2 'Boucle et chargement de chaque chemin accès
Source = """" & Inter2 & """"
counter = counter + 1

'Copie Source vers Destination
FileCopy Source, Destination

Next s

End Sub

2. Feuil2 :

D:\Documents\TOTO\Travail\BDD\ANALYSE.xlsx
D:\Documents\TOTO\Travail\BDD\ANALYSE_20220221.xlsx
D:\Documents\TOTO\Travail\BDD\compare.py
D:\Documents\TOTO\Travail\BDD\DIR-LIST1.1.xlsm
D:\Documents\TOTO\Travail\BDD\EXTRACT.txt
D:\Documents\TOTO\Travail\BDD\ANALYSE.docx

 

[Oneida]

Bonjour,

Comment effectez vous inter2?

 

[Nermal64]

Bonjour,

J'affecte à inter2 la cellule lue par la boucle for each / Next. ( ActiveWorkbook.Sheets("Feuil2").Cells(counter, 1) = Inter2 ). Il semblerait que les termes de l'égalité soient peut-être inversés...

Par contre en corrigeant les termes comme ci-dessous, toujours le même message d'erreur : Erreur d'exécution '52'

For Each s In ActiveWorkbook.Sheets
Inter2 = """" & ActiveWorkbook.Sheets("Feuil2").Cells(counter, 1) & """" 'Boucle et chargement de chaque chemin accès
Source = """" & Inter2 & """"
counter = counter + 1

'Copie Source vers Destination
FileCopy Source, Destination

 

[Oneida]

Re,
Pouvez mettre un fichier exemple avec des donnees coherentes a dispo?

 

[Nermal64]

Oui, pas de souci !
J'ai positionné le dossier comportant les données au format zip.

Merci beaucoup de vous pencher sur mes soucis!!

 

[Oneida]

Bonjour,

Pas de

D:\BDD\DIR-LIST1.1.xlsm

Donc erreur,

 

[Nermal64]

Bonjour,
Oui effectivement, j'ai noté cette erreur que j'avais corrigé, en simplifiant d'ailleurs des notifications dans le code qui n'avaient pas d'intérêt...
j'en suis pas loin dans la résolution de mon affaire:

Code revu :

Sub Transfert()

Dim objShell As Object, objFolder As Object, oFolderItem As Object, Fso As Object
Dim Source As String, Inter1 As String, Inter2 As String, Destination As String
Dim counter As Integer
counter = 1

'localiser arbrorescence de sauvegarde
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire de destination", &H1&)
Set oFolderItem = objFolder.Items.Item

'Sauvegarde dans un dossier
Destination = oFolderItem.Path & "\"

'feuille = sheet
'classeur = workbook
'classeur actif = activeworkbook

For Each s In ActiveWorkbook.Sheets
Source = ActiveWorkbook.Sheets("Feuil2").Cells(counter, 1) 'Boucle et chargement de chaque chemin accès

counter = counter + 1

'Copie Source vers Destination
FileCopy Source, Destination

Next s

End Sub


Mais j'ai malgré tout un message Erreur d'excution'76': Chemin d'accès introuvable.

Lors du débogage, je peux pourtant voir les bons chemins d'accès en pointant sur les "source" et "destination" dans mon code :

Y a t il une erreur dans le formalisme de mes chemins d'accès ?

Merci d'avance !

 

[Nermal64]

J'ai réussi à réaliser la boucle de copier/coller des fichiers présents dans la liste, mais uniquement les deux premiers fichiers (deux premières lignes) sont prises en compte.

voici le code :

Sub Transfert()

Dim objShell As Object, objFolder As Object, oFolderItem As Object, fso As Object
Dim Source As String, Inter1 As String, Inter2 As String, Destination As String
Dim counter As Integer


counter = 1

'localiser arbrorescence de sauvegarde
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire de destination", &H1&)


Set oFolderItem = objFolder.Items.Item

'Sauvegarde dans un dossier
Destination = oFolderItem.Path & "\"


'feuille = sheet
'classeur = workbook
'classeur actif = activeworkbook

For Each s In ActiveWorkbook.Sheets
Source = ActiveWorkbook.Sheets("Feuil2").Cells(counter, 1) 'Boucle et chargement de chaque chemin accès
counter = counter + 1
'Copie Source vers Destination
Set objShell = CreateObject("WScript.shell")
objShell.Run "cmd /K xcopy " & Source & " " & Destination, vbHide
Next s

End Sub


Merci par avance

 

[Oneida]

Re,
Tout a normal Thierry
Vous faites une boucle sur les feuilles, pas sur les cellules de la feuil2

For Each s In ActiveWorkbook.Sheets

De plus si les infos de la feuil2 commencent a la ligne 2, vous faites un tour pour rien

 

[Nermal64]

Oui, bonjour,
Après modifications, le code marche impeccable...
Merci beaucoup pour le temps passé sur mes pérégrinations!