Microsoft 365 Créer un sous-dosser par Client

[Usine à gaz]

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...

 

[TooFatBoy]

Je propose donc ceci :

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ù :

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

 

[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 :

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+

 

[Usine à gaz]

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

 

[TooFatBoy]

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

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

 

[TooFatBoy]

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

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 ?

 

[Usine à gaz]

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 ?

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.

 

[dysorthographie]

Bonjour,

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

 

[mapomme]

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.

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).

 

[TooFatBoy]

Je comprends ta surprise. Mais c'est spécial et pas de souci.

Ca aurait simplifié la dénomination des fichiers.

OUI, je suis d'accord avec toi, c'est comme ça que je les nomme maintenant.

Ce n'est pas ce que tu avais dit en #33 où le format de dénomination était un peu n'importe quoi :

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

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.

 

[patricktoulon]

re
une usine a gaz doit produire du gaz et c'est tout
par les temps qui court Lionel a trouvé le bon créneau
les gaziers et distributeurs d’énergie sont les rois du monde aujourd'hui

 

[dysorthographie]

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!

 

[TooFatBoy]

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

Et donc ???

 

[Usine à gaz]

Et donc ???

bonjour TooFatBoy ; le fil , le Forum
"Et donc ???"
C'est bon, ça marche aussi
Merci à toi

 

[TooFatBoy]

C'est bon, ça marche aussi

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

 

[Usine à gaz]

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

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