XL 2013 copy de fichier entre 2 sous dossiers VBA

[adjovi7]

Bonjour

J'aurais besoins de votre aide pour résoudre ce code qui j’essaye de mettre en œuvre.
Ce-ci concerne des copy de fichier entre 2 sous dossiers ci-joint le code. J'ai parcouru des discussion concernant mon problème mais malgré ça j'arrive pas.
Désolé mon fichier est lourd et j'arrive pas a le mettre sur le site.

Sub BAF()
Dim Fso As Object, MonRepertoire As Folder, purchaseOrder As String, chemin As String, destinationSource As String, bonAfacturer As String
Dim f1 As Object, f2 As Object


destinationSource = "F:\DEVIS\SUIVI COMMANDES ET DEVIS\" 'Localisation du dossier des devis sur le disk
chemin = destinationSource
purchaseOrder = chemin & "\03-Purchase Order\" 'sous repertoire du dossier des devis contenant le fichier PDF
bonAfacturer = chemin & "\08-BAF" ' sous repertoire du dossier devis vide a l'origine

Set Fso = CreateObject("Scripting.FileSystemObject")
Set MonRepertoire = Fso.GetFolder(purchaseOrder) 'défaut sur cette ligne

For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders 'boucle de parcourt des dossiers
For Each f2 In f1.Files
FileCopy purchaseOrder, bonAfacturer 'copy du fichier pdf du sous dossier 3 vers 8
Next f2
Next f1
End Sub

Cordialement,
Adjovi7

 

[Dranreb]

Re : copy de fichier entre 2 sous dossiers VBA

Bonjour

Si As Folder passe, alors je suppose que "Microsoft Scripting Runtime" est cochée. Alors remplacez tous les Object par leur type explicite: Fso As FileSystemObject, … F1 As Folder, F2 as File.
Set Fso = New FileSystemObject et après le Set MonRepertoire = etc., faire :
For Each F1 In MonRepertoire.SubFolders simplement.

Et sans doute quelque chose comme: FileCopy F2.FullName, bonAfacturer & "\" & F2.FileName 'copy du fichier pdf du sous dossier 3 vers 8
Mais à vérifier. Facile: maintenant qu'il y a partout des liaisons anticipées les nom des propriétés et méthodes possibles vous seront suggérées dès la frappe du point derrière le nom d'objet.

 

[adjovi7]

Re : copy de fichier entre 2 sous dossiers VBA

Bonjour,

Merci pour votre aide je mets ça en œuvre

Bien cordialement,