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

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 :

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

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

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

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

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

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

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

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

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

Usine à gaz

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

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
  • Question
Relance client par mail.
Réponses
10
Affichages
12 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…