VBA copie d'un répertoire à un autre

Rapace -  
 rorolidalgo -
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
Configuration: Windows XP
Internet Explorer 7.0

8 réponses

  1. Utilisateur anonyme
     
    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
    3
  2. Rapace
     
    CStr(oFichier) ne fonctionne pas...comment puis-je récupérer le nom de mon fichier SVP??

    Merci d'avance
    0
  3. Utilisateur anonyme
     
    Bonjour,

    L'instruction : dest = racine_portal & "\" & CStr(oFichier)

    devrait se lire : dest = racine_portal & "\" & oFichier.Name

    Lupin
    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. Utilisateur anonyme
     
    re :

    tout comme :

    Source = oRep & "\" & CStr(oFichier)

    Source = oRep & "\" & oFichier.Name

    Lupin
    0
  7. rapace
     
    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é.
    0
  8. rapace
     
    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).
    0
  9. Utilisateur anonyme
     
    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
    0
    1. SeB
       
      Bonjour

      Je suis face à un problème similaire, où je souhaite déplacer un dossier et son contenu selon des variables en amont.

      Je cherche à faire la manipulation suivante

      Déplacer le contenu de chemin_1\dossier_1 vers chemin_2 \ dossier_2.

      Je suis en VBA, c'est pour une gestion documentaire pilotée depuis Access.

      Merci d'avance
      0
      1. rorolidalgo > SeB
         
        Bonjour Seb,

        j'ai le même problème que toi: je souhaite faire une copie complète d'un dossier avec ses sous-dossiers et ses fichiers à part d'Access et le renommer ensuite.
        As-tu trouvé la solution à ton problème?

        Merci d'avance,
        0

Discussions similaires

Copier un lien instagram
alaurore -
LEFEUVRE -

7 réponses
Retrouver liens copiés sur le téléphone
SAMA -
Lylou -

2 réponses
copie d'un lien dans le navigateur internet
Ulysse Orseau -
diamantnoir -

4 réponses
erreur d'execution 9, l'indice n'appartient pas à la sélection
isidoh -
isidoh -

18 réponses