Copie de fichiers et de dossiers à l'unité en VBA

evosub · 17 Juin 2013

Bonjour à tous !

J'ai un petit soucis. Pour la petite histoire j'ai acheté 4 cartes SD de 32 go sur KGBDEALS et ces dernières sont défectueuses.. Je ne peux malheureusement les renvoyer car le service client m'informe qu'elles ne sont plus dans leur emballage d'origine. (évidemment pour les utiliser il faut les sortir de cet emballage... un service client au poil hein ?)
Bref ces cartes font n'importe quoi quand je copie plusieurs fichiers en même temps. En revanche j'ai remarqué que lorsque je copié un fichier à la fois il n'y a pas de problème.
Je souhaite me servir de ces cartes dans ma voiture pour lire des mp3. Mais remplir des cartes de 32 go fichier par fichier c'est très long. J'ai donc penser à faire une macro Excel pour gérer cette copie. Quitte à laisser le PC tourner pendant 2 jours...

Pour simplifier j'ai un dossier MP3 sur le bureau. Ce que je souhaite c'est qu'en appuyant sur un bouton la macro détecte les dossiers et les fichiers contenu dans ce dossier MP3 et les copies un a un sur la carte SD.
Mais je sèche complétement sur la façon de procéder avec le code.

Je connais la commande

Code:

Filecopy

en revanche je ne sais pas comment détecter l'ensemble des fichiers et dossier du répertoire MP3 et surtout réaliser l'opération de copie fichier par fichier.
Pourrait on me fournir quelques pistes ?

Merci d'avance,

Evo

Papou-net · 17 Juin 2013

Re : Copie de fichiers et de dossiers à l'unité en VBA

Bonjour Evo, et bienvenue,

Voici un lien où tu pourras trouver de l'aide adaptée à ton besoin.

Il est rédigé en anglais, mais tu peux regarder tout particulièrement le module Copying a Set of Files qui effectue la copie de tous les fichiers d'un répertoire. Je ne sais pas ce qu'il en est des sous-répertoires, le plus simple est que tu le testes par toi-même sur ton classeur, après avoir bien entendu modifié l'extension de fichiers .txt par .mp3.

Cordialement.

evosub · 17 Juin 2013

Re : Copie de fichiers et de dossiers à l'unité en VBA

Merci pour votre réponse,

Code:

Sub test()

Dim SourceFichier, DestinationFichier
SourceFichier = "C:\Users\BW\Desktop\TEST\*.mp3"
DestinationFichier = "C:\Users\BW\Desktop\COPIE\"

Const OverwriteExisting = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile SourceFichier, DestinationFichier, OverwriteExisting
End Sub

Ce code fonctionne, cependant je m’interroge sur la manière dont il copie.
Je ne pense pas que la copie se fasse fichier par fichier ou bien ?

J'étais partis sur un code de ce genre :

Code:

Sub mp3()

Dim lecteur As String
Dim nomdossier, nomsousdossier, nomfichier As String
Dim SourceFichier, DestinationFichier




lecteur = Cells(4, 2).Value
SourceFichier = "C:\Users\BW\Desktop\TEST\"
DestinationFichier = "C:\Users\BW\Desktop\COPIE\"

With Application.FileSearch
.LookIn = SourceFichier
.Filename = "*.mp3"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
[COLOR="#FF0000"]FoundFiles(i).Copy
FoundFiles(i).Paste DestinationFichier[/COLOR]
Next i
Else
MsgBox "There were no files found."
End If
End With

Mais la syntaxe des lignes en rouge m'échappe. Je ne sais d'ailleurs pas si c'est réalisable de cette façon.

MJ13 · 17 Juin 2013

Re : Copie de fichiers et de dossiers à l'unité en VBA

Bonjour Evosub, Papou

Tu peux tester ce fichier qui te permet, si tu connais un peu le VBA, sans trop d'effort, de faire des copies paramètrables.

https://www.excel-downloads.com/thr...e-divers-folder-vers-un-folder-unique.207228/

Papou-net · 17 Juin 2013

Re : Copie de fichiers et de dossiers à l'unité en VBA

RE:

Je n'ai pas une grande expérience de copie de fichiers en vba excel, mai je te propose de modifier comme suit:

Code:

Sub mp3()
  Dim Fichier
  Dim nomdossier, nomsousdossier, nomfichier As String
  Dim SourceFichier, DestinationFichier

  SourceFichier = "C:\Users\BW\Desktop\TEST\"
  DestinationFichier = "C:\Users\BW\Desktop\COPIE\"

    lecteur = Cells(4, 2).Value
    SourceFichier = "C:\Users\BW\Desktop\TEST\"
    DestinationFichier = "C:\Users\BW\Desktop\COPIE\"
  'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(SourceFichier & "*.mp3")
    
    Do While Len(Fichier) > 0
        FileCopy SourceFichier & Fichier, DestinationFichier & Fichier
        Fichier = Dir()
    Loop
End Sub

Ce code copie les fichiers un à un, mais n'inclut pas les sous-répertoires. Pour traiter ces derniers, tu peux trouver probablement la solution en lien ci-joint :

FAQ MS-Excel
A +

Cordialement.

Edit : salut Michel

evosub · 17 Juin 2013

Re : Copie de fichiers et de dossiers à l'unité en VBA

Re,

Merci pour vos réponses !
Finalement j'ai opté pour un code du style :

Code:

  Sub mp3()

   
    Dim SourceFichier, DestinationFichier
    SourceFichier = "C:\Users\BW\Desktop\TEST\*.pdf"
    DestinationFichier = "C:\Users\BW\Desktop\COPIE\"
    
    
    SourceFichier = "C:\Users\BW\Desktop\TEST\"
    DestinationFichier = "C:\Users\BW\Desktop\COPIE\"
    nomfichier = "*.pdf"
    

    Dim FSO As Scripting.FileSystemObject
    Dim DossierSource As Scripting.Folder
    Dim Fichier As Scripting.File
    
    
    Set FSO = New Scripting.FileSystemObject
    Set DossierSource = FSO.GetFolder(SourceFichier)
    For Each Fichier In DossierSource.Files
    FSO.CopyFile SourceFichier & nomfichier, DestinationFichier
    Next Fichier
    
    
    Set Fichier = Nothing
    Set DossierSource = Nothing
    Set FSO = Nothing
    
    End Sub

Papou, je vais tester ta macro,

Mj13 merci également je vais de ce pas sur ton lien.

Le travail est loin d'être terminé, a présent je dois inclure les sous répertoires et surtout copier les dossiers et les sous répertoires.... Je suis pas couché quoi.

evosub · 17 Juin 2013

Re : Copie de fichiers et de dossiers à l'unité en VBA

J'ai plus ou moins résolu mon problème :

Code:

    Dim idx As Long
    Dim SourceFichier, DestinationFichier, cheminsousdossier, nomsousdossier
    Dim lecteur As String
    
    Dim fso As Scripting.FileSystemObject
    Dim DossierSource As Scripting.Folder
    Dim Sousdossier As Scripting.Folder
    Dim Fichier As Scripting.File
    
    lecteur = Cells(4, 2).Value
    SourceFichier = "C:\Users\BW\Desktop\TEST\"
    DestinationFichier = lecteur & ":\Users\BW\Desktop\COPIE\"
    nomfichier = "*.pdf"
    
    Set fso = New Scripting.FileSystemObject
    Set DossierSource = fso.GetFolder(SourceFichier)
    

    For Each Sousdossier In DossierSource.SubFolders
    'idx = idx + 1
    'Cells(idx, 10).Value = Sousdossier.Name
    'Cells(idx, 11).Value = Sousdossier.Path
    cheminsousdossier = Sousdossier.Path
    nomsousdossier = Sousdossier.Name
    Set Sousdossier = fso.GetFolder(cheminsousdossier)
    MkDir (DestinationFichier & nomsousdossier)
    
    For Each Fichier In Sousdossier.Files
    fso.CopyFile cheminsousdossier & "\" & nomfichier, DestinationFichier & nomsousdossier & "\"
    Next Fichier
    
    Next Sousdossier
    
 
    
    For Each Fichier In DossierSource.Files
    fso.CopyFile SourceFichier & nomfichier, DestinationFichier
    Next Fichier
    
    
    Set Fichier = Nothing
    Set DossierSource = Nothing
    Set fso = Nothing
    
    End Sub

Ce code fonctionne et copie les fichiers du dossier générale et des sous dossier. Je vais rajouter un niveau pour les sous sous dossier et on sera bon. Bon doit y 'avoir moyen d'optimiser cette usine a gaz mais bon.

MJ13 · 17 Juin 2013

Re : Copie de fichiers et de dossiers à l'unité en VBA

Re

Pour la création de dossier, en général, j'utilise plutôt cette routine très performante au lieu de Mkdir:

Code:

Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long
 
Private Sub CreationDossier(sNomRep As String)
    'ChDrive "D"
    SHCreateDirectoryEx 0&, sNomRep, 0&
End Sub
 
Sub Tst()
Dim Rep As String
    Rep = "D:\repA\repB\repC\RepD"
    CreationDossier Rep
End Sub

evosub · 17 Juin 2013

Re : Copie de fichiers et de dossiers à l'unité en VBA

Re,

Intéressant, je garde sa sous le coude !

Merci à toi !

Copie de fichiers et de dossiers à l'unité en VBA

evosub

XLDnaute Nouveau

Papou-net

XLDnaute Barbatruc

evosub

XLDnaute Nouveau

MJ13

XLDnaute Barbatruc

Papou-net

XLDnaute Barbatruc

evosub

XLDnaute Nouveau

evosub

XLDnaute Nouveau

MJ13

XLDnaute Barbatruc

evosub

XLDnaute Nouveau

Discussions similaires

Copie de fichiers et de dossiers à l'unité en VBA

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency