Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBA Word Discussion :

Enregistrer fichier dans plusieurs répertoires


Sujet :

VBA Word

  1. #1
    Membre actif
    Enregistrer fichier dans plusieurs répertoires
    Bonjour le Forum
    Je souhaiterais enregistrer, a l'enregistrement ou fermeture, un fichier word dans plusieurs sous-dossiers répartis dans un répertoire.

    Je vous explique mon schéma
    - Ouverture du fichier : je scanne un répertoire et ses sous-répertoires pour trouver tous les fichiers du méme nom
    - J'enregistre ces cibles dans une ou plusieurs variables
    - A l'enregistrement/fermeture du fichier : un pop-up me demande de confirmer l'écrasement des cibles contenues dans les variables précédentes.
    - Écrasement ou non des cibles.
    - Enregistrement du fichier dans le dossier ou je l'ai ouvert.....

    Je décris la procédure car je ne suis pas a l'aise avec les vba word,
    mais je suis plus à l'aise avec les vba Excel
    Est*ce la mm chose ??

    Merci à vous
    Bonne journée
    Seb



    ###############################
    C'est Totomatique, On va tout Totomate-isé ;-)
    ###############################

  2. #2
    Expert éminent sénior
    Citation Envoyé par GADENSEB Voir le message

    Bonjour,

    Est*ce la mm chose ??
    Oui. Faites votre code sous Excel et transposez le sous Word une fois au point.

    Un exemple qui peut vous servir : word-vba-concatener-fichiers-dat-sauvegarde-rtf-partir-document-word-docm.
    L'exemple contient un liste à liste dans un userform et une matrice qui permet de mémoriser vos choix. Il y aura juste une modification de la procédure de chargement des fichiers pour réaliser une recherche récursive dans les sous dossiers.
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  3. #3
    Membre actif
    Bonjour
    Merci de la réponse !
    je me lance sur excel et je reviens !!!!

    bonne am
    Bonne journée
    Seb



    ###############################
    C'est Totomatique, On va tout Totomate-isé ;-)
    ###############################

  4. #4
    Membre actif
    Bonjour Eric

    J'ai réussi à avancer sur ce projet grâce à job75, pour la version Excel que je remercie au passage.
    Cela fonctionne parfaitement.

    Comme au début de mon post je cherche a faire cette version de macro en VBA-Word

    J'ai créer une macro qui fonctionne sur tous les fichiers word pas le biais d'un bouton dans la barre de tâches

    J'ai un soucis de déclaration de variable "Chemin" dans






    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
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    Dim fso As Object, liste, n& 'mémorise les variablesSub pfichiers()
    '
    ' pfichiers Macro
    '
    '
    Dim fso As Object, liste, n& 'mémorise les variables
     
     
     
     
     
     
     
     
    If MsgBox("Nouvel Emplacement ?", vbYesNo, "Demande de confirmation") = vbYes Then
     
    Application.FileDialog(msoFileDialogSaveAs).Show
     
     
    End If
     
     
    Dim debut$, chemin As Long, nom$
    With ThisWorkbook
        debut = "E:\Logiciels\00 - PROJETS"
        chemin = .Path
        nom = LCase(.Name) 'minuscules
        Set fso = CreateObject("Scripting.FileSystemObject")
        ReDim liste(0) 'RAZ
        n = 0 'RAZ
        ListeRecursive fso.getfolder(debut), nom
        Application.DisplayAlerts = False
        If n Then
            For n = 0 To UBound(liste)
                .SaveAs liste(n)
            Next
        End If
        MsgBox IIf(n, n, "Aucun") & " fichier" & IIf(n > 1, "s", "") & " écrasé" & IIf(n > 1, "s", "") & " dans les sous-dossiers"
        .SaveAs chemin & "\" & nom
    End With
    Set fso = Nothing
    End Sub
     
     
    Sub ListeRecursive(f As Object, nom$)
    Dim sf As Object, fich As Object
    For Each sf In f.subfolders
        For Each fich In fso.getfolder(sf).Files
            If LCase(fich.Name) = nom Then
                ReDim Preserve liste(n)
                liste(n) = sf & "\" & nom
                n = n + 1
            End If
        Next fich
        ListeRecursive fso.getfolder(sf), nom
    Next sf
    End Sub
     
     
    End Sub


    Comment doit-on déclarer dans word ?

    En te remerciant.
    Bonne journée
    Seb



    ###############################
    C'est Totomatique, On va tout Totomate-isé ;-)
    ###############################

  5. #5
    Expert éminent sénior
    Citation Envoyé par GADENSEB Voir le message

    Bonjour,

    Je n'ai pas ouvert les fichiers, mais si la procédure jointe est lancée depuis Word, cela ne peut pas être With ThisWordBook, mais With ActiveDocument.
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  6. #6
    Membre actif
    Hello.
    Une erreur de débutant de ma part.
    Je regarde cela dans la journée.
    Merci a toi
    Bonne journée
    Seb



    ###############################
    C'est Totomatique, On va tout Totomate-isé ;-)
    ###############################

  7. #7
    Expert éminent sénior
    Citation Envoyé par GADENSEB Voir le message

    Bonjour,

    Ce code fonctionne :
    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
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
     
    Option Explicit
     
    Dim Fso As Object, Liste, N& 'mémorise les variables
     
    Sub EcraserFichiers()
     
    Dim Debut$, Chemin$, Nom$, ListeDesFichiers$
     
     
            If MsgBox("Nouvel Emplacement ?", vbYesNo, "Demande de confirmation") = vbYes Then
               Application.Dialogs(wdDialogFileSaveAs).Show
            End If
     
            With ActiveDocument
     
                 ListeDesFichiers$ = "Liste des fichiers écrasés : " & Chr(10)
     
                 Debut = "E:\Logiciels\00 - PROJETS"
                 Chemin = .Path
                 Nom = LCase(.Name) 'minuscules
                 Set Fso = CreateObject("Scripting.FileSystemObject")
                 N = 0 'RAZ
                 ReDim Liste(N) 'RAZ
                 ListeRecursive Fso.getfolder(Debut), Nom
     
                 Application.DisplayAlerts = False
                 If N Then
                    For N = 0 To UBound(Liste)
                        .SaveAs Liste(N)
                        ListeDesFichiers$ = ListeDesFichiers$ & Mid(Liste(N), Len(Debut) + 1) & Chr(10)
                        'Debug.Print Liste(n)
                    Next
                 End If
                 MsgBox IIf(N, N, "Aucun") & " fichier" & IIf(N > 1, "s", "") & " écrasé" & IIf(N > 1, "s", "") & " dans les sous-dossiers" & Chr(10) & ListeDesFichiers
     
                 .SaveAs chemin & "\" & nom
            End With
     
            Application.DisplayAlerts = True
     
            Set Fso = Nothing
     
    End Sub
     
    Sub ListeRecursive(f As Object, Nom$)
     
    Dim Sf As Object, Fich As Object
     
        For Each Sf In f.subfolders
            For Each Fich In Fso.getfolder(Sf).Files
                If LCase(Fich.Name) = Nom Then
                    ReDim Preserve Liste(N)
                    Liste(N) = Sf & "\" & Nom
                    N = N + 1
                End If
            Next Fich
            ListeRecursive Fso.getfolder(Sf), Nom
        Next Sf
     
    End Sub
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  8. #8
    Membre actif
    C'est génial
    cela fonctionne parfaitement

    bonne am et merci encore
    Bonne journée
    Seb



    ###############################
    C'est Totomatique, On va tout Totomate-isé ;-)
    ###############################

  9. #9
    Membre actif
    Rebonsoir

    Le code fonctionne super bien mais je voudrais rajouter un niveau de validation par l'utilisateur

    au moment du déclenchement, je voudrais valider la liste des cibles du futur écrasement avec qqc comme cela :

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    If MsgBox("Merci de confirmer la suppression dans ?" & Chr(10) & ListeDesFichiers, vbYesNo, "Demande de confirmation") = vbYes Then


    ou le placer dans le 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
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    Option Explicit 
    Dim Fso As Object, Liste, N& 'mémorise les variables
     
     
     
     
    Sub MULTILOCALISATIONS()
     
     
     
     
     
     
     
    Dim Debut$, Chemin$, Nom$, ListeDesFichiers$
     
     
            If MsgBox("Nouvel Emplacement ?", vbYesNo, "Demande de confirmation") = vbYes Then
               Application.Dialogs(wdDialogFileSaveAs).Show
            End If
     
            With ActiveDocument
     
                 ListeDesFichiers$ = "Liste des fichiers écrasés : " & Chr(10)
     
                 Debut = "E:\Logiciels\00 - PROJETS"
                 Chemin = .Path
                 Nom = LCase(.Name) 'minuscules
                 Set Fso = CreateObject("Scripting.FileSystemObject")
                 N = 0 'RAZ
                 ReDim Liste(N) 'RAZ
                 ListeRecursive Fso.getfolder(Debut), Nom
     
     
     
                 Application.DisplayAlerts = False
                 If N Then
                    For N = 0 To UBound(Liste)
                        .SaveAs Liste(N)
                        ListeDesFichiers$ = ListeDesFichiers$ & Mid(Liste(N), Len(Debut) + 1) & Chr(10)
                        'Debug.Print Liste(n)
                    Next
                 End If
                 MsgBox IIf(N, N, "Aucun") & " fichier" & IIf(N > 1, "s", "") & " écrasé" & IIf(N > 1, "s", "") & " dans les sous-dossiers" & Chr(10) & ListeDesFichiers
     
                 .SaveAs Chemin & "\" & Nom
     
     
            Application.DisplayAlerts = True
     
            Set Fso = Nothing
         End If
         End With
    End Sub
     
    Sub ListeRecursive(f As Object, Nom$)
     
    Dim Sf As Object, Fich As Object
     
        For Each Sf In f.subfolders
            For Each Fich In Fso.getfolder(Sf).Files
                If LCase(Fich.Name) = Nom Then
                    ReDim Preserve Liste(N)
                    Liste(N) = Sf & "\" & Nom
                    N = N + 1
                End If
            Next Fich
            ListeRecursive Fso.getfolder(Sf), Nom
        Next Sf
     
    End Sub


    en te remerciant
    Bonne journée
    Seb



    ###############################
    C'est Totomatique, On va tout Totomate-isé ;-)
    ###############################

  10. #10
    Expert éminent sénior
    Citation Envoyé par GADENSEB Voir le message

    Bonjour,

    Plusieurs possibilités :
    • La plus simple serait de poser la question à l'intérieur de la procédure ListeRecursive.
    • L'autre offrant plus de lisibilité et moins d'"irritant" serait un liste à liste dans un Userform comme dans l'exemple indiqué dans un de mes précédents messages.


    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
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
     
    Option Explicit
     
    Dim Fso As Object, Liste() As Variant, N&, Debut$ 'mémorise les variables
     
    Sub EcraserFichiers()
     
    Dim Chemin$, Nom$, ListeDesFichiers$
    Dim NbFichiersEcrases As Integer
     
            If MsgBox("Nouvel Emplacement ?", vbYesNo, "Demande de confirmation") = vbYes Then
               Application.Dialogs(wdDialogFileSaveAs).Show
            End If
     
            With ActiveDocument
     
                 ListeDesFichiers$ = Chr(10)
     
                 Debut = "E:\Logiciels\00 - PROJETS"
                 Chemin = .Path
                 Nom = LCase(.Name) 'minuscules
                 Set Fso = CreateObject("Scripting.FileSystemObject")
                 N = 0 'RAZ
                 ListeRecursive Fso.getfolder(Debut), Nom
     
                 Application.DisplayAlerts = False
                 NbFichiersEcrases = 0
                 If N Then
                    For N = LBound(Liste, 1) To UBound(Liste, 1)
                           .SaveAs Liste(N)
                           ListeDesFichiers$ = ListeDesFichiers$ & Mid(Liste(N), Len(Debut) + 1) & Chr(10)
                           NbFichiersEcrases = NbFichiersEcrases + 1
                    Next
                 End If
                 MsgBox IIf(NbFichiersEcrases, NbFichiersEcrases, "Aucun") & " fichier" & IIf(NbFichiersEcrases > 1, "s", "") & " écrasé" & IIf(NbFichiersEcrases > 1, "s", "") & " dans les sous-dossiers" & Chr(10) & ListeDesFichiers
     
            End With
     
            Application.DisplayAlerts = True
     
            Set Fso = Nothing
     
    End Sub
     
    Sub ListeRecursive(f As Object, Nom$)
     
    Dim Sf As Object, Fich As Object
     
        For Each Sf In f.subfolders
            For Each Fich In Fso.getfolder(Sf).Files
                If LCase(Fich.Name) = Nom Then
                   If MsgBox("Merci de confirmer la suppression dans ?" & Chr(10) & Mid(Sf, Len(Debut) + 1), vbYesNo, "Demande de confirmation") = vbYes Then
                      ReDim Preserve Liste(N)
                      Liste(N) = Sf & "\" & Nom
                     N = N + 1
                   End If
     
                End If
            Next Fich
            ListeRecursive Fso.getfolder(Sf), Nom
        Next Sf
     
    End Sub
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  11. #11
    Membre actif
    Bonsoir,
    Je n'avais pas vu ta réponse.
    Désolé
    Cela marche nikel
    Merci à toi
    bonne soirée
    Bonne journée
    Seb



    ###############################
    C'est Totomatique, On va tout Totomate-isé ;-)
    ###############################