Microsoft 365 Créer un sous-dosser par Client

Usine à gaz

Usine à gaz

XLDnaute Barbatruc
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 :
1670517524265.png

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
job75
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
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
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
job75

job75

XLDnaute Barbatruc
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

  • Dossier.zip
    53.3 KB · Affichages: 6
Vote positif 0 Vote négatif
Solution
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
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
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
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
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Usine à gaz à dit:
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
Cliquez pour agrandir...
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
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
TooFatBoy à dit:
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 ?
Cliquez pour agrandir...
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
dysorthographie

dysorthographie

XLDnaute Accro
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
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
Usine à gaz à dit:
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.
Cliquez pour agrandir...
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
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
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 :
Usine à gaz à dit:
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
Cliquez pour agrandir...
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
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
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
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
TooFatBoy à dit:
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 quine répond pas à la question de ton fil. ;)


Sur ce, bon dimanche à tous
Adios amigos
Cliquez pour agrandir...
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

Discussions similaires

J
  • Question
créer un tableau récapitulatif par client du CA annuel
Réponses
3
Affichages
5 K
jackalop
J
G
  • Question
boucle pour créer un fichier par référence depuis un fichier de base
Réponses
2
Affichages
2 K
papapaul
papapaul
vins1892
  • Question
Relance client par mail.
Réponses
10
Affichages
12 K
Agatheb
A

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 45 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 104
dernier inscrit
JEMADA