Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 ecraser fichier excel dans plusieurs sous-dossiers répartis dans différents répertoires

GADENSEB

XLDnaute Impliqué
Bonjour le Forum
Je souhaiterais enregistrer, a l'enregistrement ou fermeture, un fichier excel dans plusieurs sous-dossiers répartis dans différents répertoires.
je l'ai nommé : ALPHA 1.xlsx

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
- Proposer un nouvel endroit ou plusieurs ou l'enregistrer.....

Est-ce jouable ?

En vous remerciant
et bonne nuit
Seb
 
Trier par date Trier par votes

job75

XLDnaute Barbatruc
Mettez tout ce code dans le module que vous voulez :
VB: 
Dim fso As Object, liste, n& 'mémorise les variables

Sub EcraserFichiers()
Dim chemin$, nom$
With ThisWorkbook
    chemin = .Path
    nom = .Name
    Set fso = CreateObject("Scripting.FileSystemObject")
    ReDim liste(0) 'RAZ
    n = 0 'RAZ
    ListeRecursive fso.getfolder(chemin), 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
For Each sf In f.subfolders
    If Dir(sf & "\" & nom) <> "" Then
        ReDim Preserve liste(n)
        liste(n) = sf & "\" & nom
        n = n + 1
    End If
    ListeRecursive fso.getfolder(sf), nom
Next sf
End Sub
Edit : ajouté la MsgBox.
 

Pièces jointes

  • Classeur1.zip
    68.7 KB · Affichages: 8
Dernière édition:
Vote positif 0 Vote négatif

GADENSEB

XLDnaute Impliqué
Hello Job75
je viens de tester ton fichier
cela semble marcher normalement merci
J'aurais du préciser dans mon premier post que le recherche récursive devait se positionner, mea culpa, dans un dossier précis
chemin = "E:\Logiciels\00 - PROJETS"
ce chemin inclut le dossier dans lequel est le fichier dont on s'occupe, il faut donc l'exclure dans la recherche récursive...
J'ai cette erreur après ma modification de "Chemin"
Comment faire cette exclusion ?

Bonne journée à toi






VB: 
Dim fso As Object, liste, n& 'mémorise les variables

Sub EcraserFichiers()
Dim chemin$, nom$
With ThisWorkbook
    chemin = "E:\Logiciels\00 - PROJETS"
    'chemin = .Path
    nom = .Name
    Set fso = CreateObject("Scripting.FileSystemObject")
    ReDim liste(0) 'RAZ
    n = 0 'RAZ
    ListeRecursive fso.getfolder(chemin), 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
For Each sf In f.subfolders
    If Dir(sf & "\" & nom) <> "" Then
        ReDim Preserve liste(n)
        liste(n) = sf & "\" & nom
        n = n + 1
    End If
    ListeRecursive fso.getfolder(sf), nom
Next sf
End Sub
 

Pièces jointes

  • V1 - ENREGISTER FICHIER A PLUSIEURS ENDROITS.xlsm
    20.4 KB · Affichages: 6
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
GADENSEB à dit:
chemin = "E:\Logiciels\00 - PROJETS"
ce chemin inclut le dossier dans lequel est le fichier dont on s'occupe, il faut donc l'exclure dans la recherche récursive...
Cliquez pour agrandir...
Il est tout à fait inutile de faire une quelconque exclusion.

Simplement le fichier de la macro sera enregistré 2 fois : une fois dans son sous-dossier et une fois en fin de macro dans le dossier chemin.

J'ai testé moi aussi comme vous l'avez fait avec un dossier "antérieur", sans aucun problème.

Je ne sais pas d'où vient le bug avec la fonction Dir : quand le fichier n'est pas trouvé elle renvoie normalement "".

Il faudrait que vous nous disiez quel est la valeur du sous-dossier sf au moment du bug : placez le curseur dessus.
 
Dernière édition:
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
Bonjour GADENSEB,

J'ai lu quelque part que Dir peut entraîner un bug quand on l'utilise dans des itérations.

Avec ce code on l'évite mais c'est plus long :
VB: 
Dim fso As Object, liste, n& 'mémorise les variables

Sub EcraserFichiers()
Dim debut$, chemin$, 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
Bonne journée.
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Question
Power Query [Resolu] Importer plusieurs fichiers excel provenant de dossiers différents sur sharepoint
Réponses
6
Affichages
1 K
Staple1600
C
  • Résolu(e)
XL 2019 Recherche dans les sous dossiers d'un répertoire via VBA sur excel
2
Réponses
27
Affichages
729
chaval
C
S
  • Question
XL 2019 besoin d aide pour le développement d'un fichier rangements vers les répertoires attitré
Réponses
6
Affichages
406
stef60400
S
F
  • Question
XL 2016 copier des fichiers dans des sous dossiers a partir de case a cocher sous excel
2
Réponses
17
Affichages
1 K
Felipe54
F
S
  • Question
Autres Comment envoyer directement un fichier Excel, vers périphérique Bluetooth, après enregistrement?
Réponses
3
Affichages
340
patricktoulon
L
  • Résolu(e)
XL 2016 Récupérer données de différents fichiers Excel et rappatrier dans 1 seul fichier
Réponses
5
Affichages
694
LAPIN-53
L
E
  • Question
XL 2013 enregistrement d'un meme fichier excel sous des noms différents
Réponses
3
Affichages
543
Staple1600
M
  • Question
XL 2016 Erreur d'execution '52': Nom ou numéro de fichier incorrect
Réponses
4
Affichages
1 K
macseb
M
J
  • Résolu(e)
XL 2019 Recherche de données sur plusieurs fichier différents VBA
Réponses
3
Affichages
837
Hasco
  • Question
XL 2019 Ouvrir excel sur un fichier existant dans un cloud
Réponses
8
Affichages
2 K
TooFatBoy
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…