XL 2016 Macro chargement liste arborescence, copier coller fichiers

Nermal64

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

Nermal64

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

Nermal64

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


1697629345982.png


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

1697629618449.png


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

Merci d'avance !
 

Pièces jointes

  • 1697629373496.png
    1697629373496.png
    123.2 KB · Affichages: 12

Nermal64

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

XLDnaute Impliqué
Re,
Tout a normal Thierry
Vous faites une boucle sur les feuilles, pas sur les cellules de la feuil2
VB:
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
 

Discussions similaires

Statistiques des forums

Discussions
313 309
Messages
2 097 031
Membres
106 812
dernier inscrit
Excellou74