VBA copie d'un répertoire à un autre Fermé

Question

Bonjour,

Voilà, je souhaite parcourir une arborescence de répertoires, et de copier l'ensemble de leurs contenus dans une structure similaire (tout en renommant certains répertoires).

voici donc déjà le début de mon code que je teste avant d'aller plus loin. 


Code :
Private Sub Commande0_Click()
 
    Dim oFS As Variant, oLecteur As Variant, oRepertoire As Variant
    Dim Boucle As Variant
    Dim Dossier As Variant
    Dim rep As String
    
    On Error Resume Next
 
    Set oFS = CreateObject("Scripting.FileSystemObject")
    Set oLecteur = oFS.GetDrive("G")
 
    Dossier = "\Corbeil documentations\customer\Actel\A3P060\Customer Data"
    If (oLecteur.IsReady) Then
        If (Dossier <> "") Then
            'cteLecture à partir du sous-répertoire cible
            Set oRepertoire = oFS.GetFolder(oLecteur & ":" & Dossier)
            rep = "G:" & Dossier
            Call ListeFichier(oRepertoire, rep) ' Routine récursive
        End If
    End If
    Wscript.Echo "Fin de traitement :-) "
 
End Sub
'
 
Sub ListeFichier(ByVal oRepertoir As Variant, ByVal oRep As String)    ' Routine récursive
 
    Dim oDossier As Variant, oFichier As Variant
    Dim Source, dest, racine_portal As String
 
    On Error Resume Next
 
    racine_portal = "G:\Corbeil doc for Portal\customer\Actel\A3P060\Customer Data"
 
    If (oRepertoir.Files.Count > 0) Then
        For Each oFichier In oRepertoir.Files
            Source = oRep & "\" & CStr(oFichier)
            dest = racine_portal & "\" & CStr(oFichier)
            FileCopy Source, dest
        Next
    End If
 
    If (oRepertoir.SubFolders.Count > 0) Then
        For Each oDossier In oRepertoir.SubFolders
            Call ListeFichier(oDossier, oDossier)
        Next
    End If
        
End Sub 


Mon problème principal est que je n'arrive pas à récupérer le nom du variant oFichier pour le concaténer à mon chemin d'accès. Cela fait planter mon FileCopy...

Pouvez vous m'indiquer comment récupérer le nom( + extension) du variant oFichier SVP?

Bien sûr, toute autre idée, ou autre façon de faire pour améliorer ce code est la bienvenue....

merci d'avance

Utilisateur anonyme · Accepted Answer

re :

Alors voilà mes observations, vous confondez objets de scriptings et objets de VBA

Voici le script en vbs :

Dim oFS , oLecteur , oRepertoire 
'Dim Boucle 
Dim Dossier
Dim Rep 
Dim Compteur

On Error Resume Next 

Compteur=0
Set oFS = CreateObject("Scripting.FileSystemObject") 
Set oLecteur = oFS.GetDrive("R")
WScript.Echo "Lupin"
If (oLecteur.IsReady) Then 
	WScript.Echo "Lupin 1"
	Dossier = "\Forums\VBS" 
	'Dossier = "\Corbeil documentations\customer\Actel\A3P060\Customer Data" 
	'cteLecture à partir du sous-répertoire cible 
	Rep = "R:" & Dossier 
	Set oRepertoire = oFS.GetFolder(Rep)
	WScript.Echo oRepertoires.SubFolders.Count
	Call ListeFichier(oRepertoire, Rep) ' Routine récursive 
End If 

Wscript.Echo "Fin de traitement :-) " & Compteur

WScript.Quit(0)
'End Sub 
' 

Sub ListeFichier(oRepertoir, oRep ) ' Routine récursive 

Dim oDossier , oFichier  
Dim Source, dest, racine_portal 

On Error Resume Next 

Compteur = ( Compteur + 1 )
'racine_portal = "G:\Corbeil doc for Portal\customer\Actel\A3P060\Customer Data" 
racine_portal = "S:\Lecteur\Transport"
WScript.Echo = oRepertoir.Files.Count
If (oRepertoir.Files.Count > 0) Then 
	For Each oFichier In oRepertoir.Files 
		Source = oRep & "\" & oFichier.Name
		WScript.Echo Source
		dest = racine_portal & "\" & oFichier.Name
		WScript.Echo dest
		oFS.CopyFile Source, dest 
	Next 
End If 

If (oRepertoir.SubFolders.Count > 0) Then 
	For Each oDossier In oRepertoir.SubFolders 
		Call ListeFichier(oDossier, oDossier) 
	Next 
End If 

End Sub 


et maintenant le même code mais sous VBA !


Option Explicit

Dim oFS As Object, oLecteur As Object, oRepertoire As Object
Dim Compteur As Long

Private Sub CommandButton1_Click()

Dim Boucle As Long
Dim Dossier As String
Dim Rep As String

On Error Resume Next

Compteur = 0
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("R")
'WScript.Echo "Lupin"
MsgBox "Lupin"
If (oLecteur.IsReady) Then
    'WScript.Echo "Lupin 1"
    MsgBox "Lupin 1"
    Dossier = "\Forums\VBS"
    'Dossier = "\Corbeil documentations\customer\Actel\A3P060\Customer Data"
    'cteLecture à partir du sous-répertoire cible
    Rep = "R:" & Dossier
    Set oRepertoire = oFS.GetFolder(Rep)
    MsgBox oRepertoire.SubFolders.Count
    'WScript.Echo oRepertoires.SubFolders.Count
    Call ListeFichier(oRepertoire, Rep) ' Routine récursive
    Compteur = (Compteur + 1)
End If

'WScript.Echo "Fin de traitement :-) " & Compteur
MsgBox "Fin de traitement :-) " & Compteur

End Sub
'

Sub ListeFichier(oRepertoir As Object, oRep As Object)  ' Routine récursive

Dim oDossier As Object, oFichier As Object
Dim Source As String, dest As String, racine_portal As String

On Error Resume Next

'racine_portal = "G:\Corbeil doc for Portal\customer\Actel\A3P060\Customer Data"
racine_portal = "S:\Lecteur\Transport"
'WScript.Echo = oRepertoir.Files.Count
MsgBox oRepertoir.Files.Count
If (oRepertoir.Files.Count > 0) Then
    For Each oFichier In oRepertoir.Files
        Source = oRep & "\" & oFichier.Name
        MsgBox Source
        'WScript.Echo Source
        dest = racine_portal & "\" & oFichier.Name
        MsgBox dest
        'WScript.Echo dest
        oFS.CopyFile Source, dest
    Next
End If

If (oRepertoir.SubFolders.Count > 0) Then
    For Each oDossier In oRepertoir.SubFolders
        Call ListeFichier(oDossier, oDossier)
    Next
End If

End Sub
'


remarquer surtout que les lignes :

Dim oFS As Object, oLecteur As Object, oRepertoire As Object
Dim Compteur As Long

définit les variables pour tout le module et seront connue de chaque routine.

De plus, votre code copie les fichiers mais pas la structure des répertoires que vous copiers.

Je vous recommande plus une commande comme oFS.CopyFolder (Source , Destination)

Lupin

Rapace · Answer

CStr(oFichier) ne fonctionne pas...comment puis-je récupérer le nom de mon fichier SVP??

Merci d'avance

Utilisateur anonyme · Answer

Bonjour,

L'instruction : dest = racine_portal & "\" & CStr(oFichier) 

devrait se lire : dest = racine_portal & "\" & oFichier.Name

Lupin

Rapace · Answer

Merci , je vais tester.

Utilisateur anonyme · Answer

re :

tout comme :

Source = oRep & "\" & CStr(oFichier) 

Source = oRep & "\" & oFichier.Name

Lupin

rapace · Answer

j'avais déjà changé pour "Source" également mais ma macro ne fonctionne toujours pas. Je n'ai pas de message d'erreur c'est juste que ma macro ne fait rien.

J'ai mis un "msgbox oFichier.Name" dans ma boucle mais ça affiche une chaine vide...

D'où peut venir le problème d'après vous? Mes chemins de données sont bons et le répertoire source contient des fichiers, j'ai vérifié.

rapace · Answer

Meric beaucoup Lupin, j'avoue ne pas avoir compris la subtilité entre ton code VBS et ton code VBA.
Le problème vindrait du fait que j'ai utilisé des Variant plutot que des Object, c'est ça??

Je vais également tester le CopyFolder. Cela copie tout un répertoire? avec son arborescence complète et son contenu?? (si c'est le cas, je vais pouvoir me passer de ma boule récursive).

Utilisateur anonyme · Answer

re :

non, ce n'est pas le typage qui était en cause !

Instruction avec des objets VBA
FileCopy Source, dest 

Instruction avec des objets de scripting
oFS.CopyFile Source, dest

Il faudra apprendre a distinguer les objets de scripting, codable dans le bloc-note
et les objets VBA codable sous VBE.

et, oui, la commande CopyFolder copie tout le contenu.

Lupin

VBA copie d'un répertoire à un autre

8 réponses

Discussions similaires