Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Macro chargement liste arborescence, copier coller fichiers

N

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
 
Trier par date Trier par votes
N

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
 
Vote positif 0 Vote négatif
N

Nermal64

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

Merci beaucoup de vous pencher sur mes soucis!!
 

Pièces jointes

  • Transfert.xlsm
    18.5 KB · Affichages: 10
  • BDD.zip
    11.5 KB · Affichages: 7
Vote positif 0 Vote négatif
N

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.




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 !
 

Pièces jointes

  • 1697629373496.png
    123.2 KB · Affichages: 12
Vote positif 0 Vote négatif
N

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
 
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

B
  • Question
XL 2016 Propriétés fichiers vidéos.
Réponses
3
Affichages
465
patricktoulon
F
  • Question
XL 2016 copier des fichiers dans des sous dossiers a partir de case a cocher sous excel
2
Réponses
17
Affichages
1 K
Felipe54
F
D
  • Question
Microsoft 365 Couper Coller Fichiers en VBA
Réponses
3
Affichages
733
patricktoulon
I
  • Question
Microsoft 365 Renommer des fichiers avec des caractères non reconnus
Réponses
10
Affichages
813
ivan27
I
  • Question
Microsoft 365 Macro .XLA découpage de fichiers à passer en X64
Réponses
8
Affichages
669
GADENSEB
O
  • Question
XL 2010 suppression fichiers excel vba
Réponses
9
Affichages
537
Oneida
J
  • Question
Microsoft 365 Macro excel spécifier chemin de sauvegarde one drive
Réponses
4
Affichages
739
.jakob@gmail.com
J
B
  • Question
XL 2019 Macro - Envoyer des mails depuis un tableau de données
Réponses
3
Affichages
1 K
AtTheOne
G
  • Question
Microsoft 365 VBA : Copier-Coller
Réponses
1
Affichages
811
Rossoneri83
R
9
  • Question
Microsoft 365 Copier Coller les données (cellules) de plusieurs feuilles d'un classeur vers plusieurs autres feuilles d'un classeur
Réponses
5
Affichages
1 K
92lever
9
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…