Discussion :

[licpegpon]

Bonjour,

Je souhaiterais créer une macro qui enregistre TOUS les fichiers situés sous le dossier P:\ENG\EXT (fichiers, dossiers et sous-dossiers de ce répertoire) et les copie dans un dossier racine que je choisis via "parcourir". Il faudrait de plus que lorsque je lance cette procédure les anciens fichiers soient écrasés.

Des propositions ? Merci par avance.

Cdlt.
Jérôme

[Igloobel]

Bonjour,

Une proposition utilise les "FilesDialogs"

[licpegpon]

Bonjour,

Merci.
Cdlt.

[TSAFACK-M]

Salut !
tu peux tester ce bout de code.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
Option Explicit
Option Private Module
Private fso As Object ' Ou Activer la Référence Microsoft Scripting Runtime pour pouvoir Définir fso en tant que Scripting.FileSystemObject
Private Const defaultSourcePath As String = "P:\ENG\EXP" 'Chemin de ton Dossier Source
Public Sub SaveFolderWhithFullContent()
    On Error GoTo ErrorFolder
    Dim newFolder As String, newPathDestination As String
    Dim oShell As Object, oFolder As Object
 
    Set oShell = CreateObject("Shell.Application")
    Set oFolder = oShell.BrowseForFolder(&H0&, "Select Your Destination Folder", &H1&)
 
    On Error Resume Next
 
    If oFolder Is Nothing Then
        newPathDestination = ""
        Exit Sub
    Else
        newPathDestination = oFolder.parentFolder.ParseName(oFolder.Title).Path & ""
        newPathDestination = newPathDestination _
                    & Application.PathSeparator _
                    & "Sauvegarde Du" _
                    & Application.WorksheetFunction.Proper(VBA.Format(VBA.Now(), "-dd mmm yyyy"))
    End If
 
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    'Vérifie et crée un nouveau dossier à chaque nouvelle sauvegarde. Cela écrasera automatiquement les Anciens Fichiers _
    si la sauvegarde s'est fait dans la même journée */
    If Not fso.FolderExists(newPathDestination) Then fso.CreateFolder newPathDestination
 
    'Copy le contenu de le dossier Source vers le dossier de Sauvegarde Choisi
    fso.CopyFolder defaultSourcePath, newPathDestination
 
    'Libérer les ressources de la Mémoire
    If Not fso Is Nothing Then Set fso = Nothing
    If Not oShell Is Nothing Then Set oShell = Nothing
    If Not oFolder Is Nothing Then Set oFolder = Nothing
    On Error GoTo 0
    Exit Sub
ErrorFolder:
    'Libérer les ressources de la Mémoire
    If Not fso Is Nothing Then Set fso = Nothing
    If Not oShell Is Nothing Then Set oShell = Nothing
    If Not oFolder Is Nothing Then Set oFolder = Nothing
 
    MsgBox "Alert ! (" & Err.Description & ")", 64 + 0, "Error Exception->" & Err.Number
End Sub

Cordialement.

[licpegpon]

Bonjour,

Désolé pour le silence radio. De nombreuses urgences à traiter avant les vacances. Un grand merci pour ce "bout de code". J'y regarde dès que possible....

Cdlt.
Jérôme.

[Menhir]

Il faudrait de plus que lorsque je lance cette procédure les anciens fichiers soient écrasés.

Le plus simple est de commencer la macro en supprimant tous les fichiers dans le répertoire de destination avant de lancer la copie.

[licpegpon]

Bonjour Menhir,
Comment cela se traduit-il dans le code ?

Bonjour TSA FACK-M,
Où dois-je mettre ce code ? Dans un module particulier ? Dans thisworkbook ? ...

Cdlt.
Jérôme

[Menhir]

Comment cela se traduit il dans le code ?

Avec l'instruction Kill : https://docs.microsoft.com/fr-fr/off...kill-statement

Ou le méthode Delete de l'objet File du FileSystem.
Lire ça :
https://docs.microsoft.com/fr-fr/off...r-applications
https://docs.microsoft.com/fr-fr/off...lp/file-object
https://docs.microsoft.com/fr-fr/off...mobject-object

[TSAFACK-M]

Bonjour Menhir,
Comment cela se traduit-il dans le code ?

Bonjour TSA FACK-M,
Où dois-je mettre ce code ? Dans un module particulier ? Dans thisworkbook ? ...

Cdlt.
Jérôme

Bonjour.

Tu peux placer le code dans un Module Standard puis insérer un bouton dans ta feuille et
faire clique droit dessus puis Affecter une macro. Dans la petite fenêtre qui s'ouvre, copis
et colle la méthode SaveFolderWhithFullContent et ok, ainsi la fenêtre Enregistrer-Sous
s'ouvrira chaque fois que tu cliqueras sur la bouton.

Cordialement;