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

Microsoft 365 Créer un sous-dosser par Client

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,

Je me tourne vers nos ténors pour la création de sous dossiers (1 par Client) et je ne vois pas vraiment comment automatiser en codage.

J'ai 2 dossiers pour les Clients :
- Factures qui contient environ 2000 factures,
- Relevés Situation Packs qui contient environ 3500 relevés,

Que ce soit les factures ou les relevés, le nom des fichiers commence toujours pas le nom du Client :
- Truc Sylvie 20210908 Votre Fact Achat Pack,
- Machin Jean-Luc - 18122017 Votre achat Pack Rest 14 RdV,
- Autre Danièle 12082016 2 100,

Pour une bien meilleure visibilité, j'aimerais les regrouper en sous-dossiers clients, c'est dire créer dans le dossier.
- Factures des sous-dossiers au nom de chaque client,
- Relevés des sous-dossiers au nom de chaque client,
ce qui donnerait, photo jointe :

Je pourrais le faire avec mes petites mains lol mais pour presque 6000 documents, je vais y passer le reste de ma vie.

Auriez-vous une solution = clic et youpi, c'est fait lol 🤣😇
Ce serait génial, mais est-ce possible ?
Merci déjà pour m'avoir lu...
🙂
 
Dernière édition:
Solution
Bonjour Lionel, le forum,

Après avoir créé les sous-dossiers avec la macro du post #19 il est facile d'annuler l'opération en détruisant les sous-dossiers avec cette macro :
VB: 
Sub Detruire_dossiers()
Dim chemin$, a, fso As Object, dossier, sf As Object, fichier As Object
chemin = ThisWorkbook.Path & "\"
a = Array("Factures", "Relevés Situation Packs")
Set fso = CreateObject("Scripting.FileSystemObject")
For Each dossier In a
    For Each sf In fso.GetFolder(chemin & dossier).SubFolders
        For Each fichier In sf.Files
            fso.MoveFile chemin & dossier & "\" & sf.Name & "\" & fichier.Name, chemin & dossier & "\" & fichier.Name
        Next fichier
        RmDir chemin & dossier & "\" & sf.Name 'supprime le sous-dossier
Next...
Trier par date Trier par votes
Je propose donc ceci :
VB: 
Sub Deplacements()
'
    Call Deplacer(ThisWorkbook.Path & "\Factures")
    Call Deplacer(ThisWorkbook.Path & "\Relevés Situation Packs")

End Sub

Sub Deplacer(DossierSource As String)
'
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each MonFichier In fso.GetFolder(DossierSource).Files
        PosEspace = InStr(MonFichier.Name, " ")
        PosEspace = InStr(PosEspace + 1, MonFichier.Name, " ")
        DossierCible = DossierSource & "\" & Left(MonFichier.Name, PosEspace - 1)
        If Len(Dir(DossierCible, vbDirectory)) = 0 Then MkDir DossierCible
        fso.MoveFile DossierSource & "\" & MonFichier.Name, DossierCible & "\" & MonFichier.Name
    Next MonFichier

End Sub


Et ceci pour remettre en l'état initial, au cas où :
VB: 
Sub Replacements()
'
    Call Replacer(ThisWorkbook.Path & "\Factures")
    Call Replacer(ThisWorkbook.Path & "\Relevés Situation Packs")

End Sub

Sub Replacer(DossierCible As String)
'
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each MonDossier In fso.GetFolder(DossierCible).SubFolders
        For Each MonFichier In fso.GetFolder(MonDossier).Files
            fso.MoveFile MonDossier & "\" & MonFichier.Name, DossierCible & "\" & MonFichier.Name
        Next MonFichier
        RmDir MonDossier
    Next MonDossier

End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Bonjour Lionel, le forum,

Après avoir créé les sous-dossiers avec la macro du post #19 il est facile d'annuler l'opération en détruisant les sous-dossiers avec cette macro :
VB: 
Sub Detruire_dossiers()
Dim chemin$, a, fso As Object, dossier, sf As Object, fichier As Object
chemin = ThisWorkbook.Path & "\"
a = Array("Factures", "Relevés Situation Packs")
Set fso = CreateObject("Scripting.FileSystemObject")
For Each dossier In a
    For Each sf In fso.GetFolder(chemin & dossier).SubFolders
        For Each fichier In sf.Files
            fso.MoveFile chemin & dossier & "\" & sf.Name & "\" & fichier.Name, chemin & dossier & "\" & fichier.Name
        Next fichier
        RmDir chemin & dossier & "\" & sf.Name 'supprime le sous-dossier
Next sf, dossier
End Sub
Les sous-dossiers ne doivent contenir que des fichiers.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Solution
Bonjour Gérard, Bernard_XLD, kiki29, TooFatBoy, Efgé ,Laurent78,Patrickn, mapomme, dysorthographie 🙂
Bonjour le Forum 🙂

A tous, je vous remercie de vous être intéressé à ma demande. Merci aussi pour vos remarques et conseils.
Merci aussi aux vilains moqueurs. Se moquer d'un pauv'e vieux sans défense, c'est pas bien lol 🤣😊😇

@ Gérard : Génial tes fichiers ça fonctionne super et c'est magique = 1 clic une 20taine de secondes plus tard, c'est fait. Vraiment magique de chez magique.

Mais il y a un petit souci qui vient de moi.
Mes fichiers se sont créer depuis une dizaine d'années et les noms des fichiers ont été modifiés selon mes évolutions :
- Truc Sylvie 20210908 Votre Fact Achat Pack,
- Machin Jean-Luc - 18122017 Votre achat Pack Rest 14 RdV,
- Autre Danièle 12082016 2 100,
Et d'autres...
Résultat, ton code créé plusieurs dossiers par Client selon les nom des fichiers existants.

Evidemment, il y a 10 ans, je n'avais pas pensé à regrouper mes fichiers par client.
Mais maintenant que je le sais, les noms des fichiers seront toujours crées comme ceci :
- pour les factures : MACHINE Mireille - Sonda 27122018 Votre achat Pack Rest 12 RdV - en cours
- pour les relevés : MACHIN Jean-Luc 20221101 Pack Rest 7 RdV - en cours

Pour l'instant j'ai beaucoup de dossiers en plusieurs exemplaires avec chaque fichier correspondant dedans.
Je vais me les déplacer avec mes mimines 🙂

TooFatBoy :​

Je vais tester ta proposition tout à l'heure et je reviendrai 🙂

Vraiment merci à tous
🙂
 
Dernière édition:
Vote positif 0 Vote négatif
Usine à gaz à dit:
Je vais tester ta proposition tout à l'heure et je reviendrai 🙂
Cliquez pour agrandir...
Ben ça fait la même chose que les macros de job75, sauf que moi je ne modifie pas les prénoms composés avec tiret, je laisse tout tel que c'est. 😉


Il existe pas mal de programmes pour t'aider à renommer tes fichiers.
Celui-ci est excellent : Bulk Rename Utility
 
Dernière édition:
Vote positif 0 Vote négatif
Perso, je pense que l'utilisation de séparateurs clairs serait un plus.

Par exemple <Espace><Underscore><Espace> :
NOM Prénom _ Facture _ aaaa-mm-jj _ Libellé _ Complément
NOM Prénom _ Relevé _ aaaa-mm-jj _ Libellé _ Complément

Je suis surpris que tes factures n'aient pas chacune un numéro unique.
Et tes clients n'ont pas non plus chacun un numéro unique de client ?
 
Vote positif 0 Vote négatif
OUI, je suis d'accord avec toi, c'est comme ça que je les nomme maintenant.
"Je suis surpris que tes factures n'aient pas chacune un numéro unique.
Et tes clients n'ont pas non plus chacun un numéro unique de client ?"
Je comprends ta surprise. Mais c'est spécial et pas de souci.
🙂
 
Vote positif 0 Vote négatif
Bonjour,
VB: 
Type Fichier
    Fichier As String
    Nom As String
    Date As String
    rest As String
    NewName As String
End Type
Sub test()
With DecoupFichier("Machin Jean-Luc - 18122017 Votre achat Pack Rest 14 RdV")
 Debug.Print .Fichier, .Nom, .Date, .rest, .NewName
End With
With DecoupFichier("Truc Sylvie 20210908 Votre Fact Achat Pac,")
 Debug.Print .Fichier, .Nom, .Date, .rest, .NewName
End With
With DecoupFichier("- Autre Danièle 12082016 2 100")
 Debug.Print .Fichier, .Nom, .Date, .rest, .NewName
End With
End Sub
Function DecoupFichier(F As String) As Fichier
Dim Start As Integer, Stope As Integer
With CreateObject("VBScript.RegExp")
    .IgnoreCase = True
    .Pattern = "[0-9]"
    With .Execute(F)
        Start = .Item(0).FirstIndex
    End With
    .Pattern = "[0-9] |10000000"
    With .Execute(F)
        Stope = .Item(0).FirstIndex
    End With
End With
DecoupFichier.Fichier = F

DecoupFichier.Nom = Replace(Trim(Replace(Trim(Left(F, Start)), "-", " ")), " ", "_")
If IsDate(Format(Mid(F, Start + 1, Stope - Start + 1), "@@-@@-@@@@")) Then
    DecoupFichier.Date = Format(CDate(Format(Mid(F, Start + 1, Stope - Start + 1), "@@-@@-@@@@")), "YYYY-MM-DD")
Else
    DecoupFichier.Date = Format(CDate(Format(Mid(F, Start + 1, Stope - Start + 1), "@@@@-@@-@@")), "YYYY-MM-DD")
End If
DecoupFichier.rest = Trim(Right(F, Len(F) - Stope - 1))
DecoupFichier.NewName = DecoupFichier.Nom & " " & DecoupFichier.Date & " " & DecoupFichier.rest
End Function
 
Vote positif 0 Vote négatif
Bonjour à tous,

Je pense que la dénomination des factures n'est pas la numérotation des factures.
La numérotation doit être unique, en ordre croissant, sans trou, sans doublon et chronologique.
Si jamais par erreur, on a émis la facture 4 puis la facture 6, le numéro 5 ne peut plus être donné à une facture puisque cette dernière serait "anti-datée" par rapport à la 6 déjà émise. Il y aura un "trou" dans la numérotation qu'il faut absolument noter pour pouvoir le justifier lors des contrôles. La compta et la GESCO sont des métiers. Vouloir en faire une avec Excel est à mon avis "hasardeux" (encore faudrait-il qu'elle soit légalement certifiable).
 
Dernière édition:
Vote positif 0 Vote négatif
Usine à gaz à dit:
Je comprends ta surprise. Mais c'est spécial et pas de souci.
Cliquez pour agrandir...
Ca aurait simplifié la dénomination des fichiers. 😉


Usine à gaz à dit:
OUI, je suis d'accord avec toi, c'est comme ça que je les nomme maintenant.
Cliquez pour agrandir...
Ce n'est pas ce que tu avais dit en #33 où le format de dénomination était un peu n'importe quoi :
C'est pour ça que je te proposais un format un peu plus structuré. 😉

Mais comme dirait notre camarade Bernard : c'est toi qui utilises les fichiers, donc c'est toi qui vois.
 
Dernière édition:
Vote positif 0 Vote négatif
j'ai repris le fichier de JOB qui me semblai un peux fébrile en USINE A GAZ 🥳🥳🥳

j'ai mis les dates au format "YYYY-MM-DD" mais tu peux modifier comme suis "YYYYMMDD" tes dates seront toutes formaté dans le même sens!
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Usine à gaz à dit:
C'est bon, ça marche aussi 🙂
Cliquez pour agrandir...
Mais comme par hasard tu préfères la solution de job (bien qu'elle soit moins bonne)... 😅

D'ailleurs, tu feras gaffe : à force de cocher ses réponses sans mêmes regarder, ici tu as coché une réponses de job qui ne répond pas à la question de ton fil. 😉


Sur ce, bon dimanche à tous
Adios amigos
 
Dernière édition:
Vote positif 0 Vote négatif
Re-Bjr,

Je ne comprends pas ton "courroux" 🙂
Job75 avait répondu bien avant ta réponse.
Contrairement à ce que tu dis, son code répond à mon besoin (du moins chez moi sauf berlue prononcée, ce qui est possible 🤣🙃🤪)

Ton code fonctionne effectivement mais chez moi, sauf berlue très prononcée et persistante, ce qui est possible 🤣🙃🤪, il est équivalant.

Malheureusement, on ne peut pas sélectionner plusieurs codes en tant de solutions.
Bien évidemment, j'ai gardé ton code mais je suis resté sur le code de Job75.

Il y a de koi me dire "Adios amigos" ?
Bon dimanche à toi aussi 🙂
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

J
  • Question Question
créer un tableau récapitulatif par client du CA annuel
Réponses
3
Affichages
5 K
jackalop
J
G
  • Question Question
boucle pour créer un fichier par référence depuis un fichier de base
Réponses
2
Affichages
2 K
papapaul
  • Question Question
Relance client par mail.
Réponses
10
Affichages
13 K
Agatheb
A
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…