XL 2019 Création de dossiers sur base fichier Excel

Amilo

XLDnaute Accro
Bonjour à tous,

J’ai une demande un peu particulière et j’ignore si cela est faisable à partir d’un fichier Excel,
Je souhaiterais svp à partir du fichier en pièce jointe, créer autant de dossiers que de comptes clients.

Le nom des dossiers aurait pour nom : le numéro de compte, le nom du Client et la fréquence de facturation
Par exemple, j’aurais pour la 1ère ligne, un dossier nommé : 411001_A_Mens

J’ai plusieurs dizaines de dossiers à créer de cette manière.

Pour le chemin, peut-on sélectionner manuellement le répertoire devant contenir les dossiers ou faut-il l’indiquer par avance ?

Merci d’avance
 

Pièces jointes

  • Dossiers Clients.xlsx
    9.7 KB · Affichages: 12
Solution
Bonjour à tous,

Avec cette solution on choisit le dossier devant recevoir les sous-dossiers :
VB:
Sub Creer_sous_dossiers()
Dim chemin$, tablo, i&, x$, n&
'---sélection du dossier---
ChDir ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = False Then Exit Sub
    chemin = .SelectedItems(1) & "\"
End With
'---création des sous-dossiers---
tablo = [Tableau1].Resize(, 3)
For i = 1 To UBound(tablo)
    x = chemin & tablo(i, 1) & "_" & tablo(i, 2) & "_" & tablo(i, 3)
    If Dir(x, vbDirectory) = "" Then MkDir x: n = n + 1
Next
MsgBox "Nombre de sous-dossiers créés : " & n
End Sub
A+

fanfan38

XLDnaute Barbatruc
Bonjour
Il est préférable d'avoir le nom de dossier sauf si c'est le même dossier que ce fichier
qu'est ce que tu appelles dossier
un répertoire par clients avec 1 fichier par répertoire
ou un fichier par client
ou une feuille par client
ci joint le fichier crée un répertoire par compte dans le même répertoire
A+ François
 

Pièces jointes

  • Dossiers Clients.xlsm
    16.1 KB · Affichages: 8
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Amilo,
1- Je suppose que par "dossier" vous parlez de Classeur ? Car Dossier est souvent utilisé pour Répertoire.
2- Je suppose que ces classeurs ne seront pas vierges, mais la copie d'une feuille d'un classeur type ?
Ce "modèle" sera t-il inclut dans le fichier Dossier_Clients ?
3- On peut mettre le chemin du répertoire cible dans une cellule dans votre feuil1, et l'exploiter en VBA.
 

Amilo

XLDnaute Accro
Bonjour fanfan38, sylvanu, Phil69970,

Je vous remercie pour votre retour,

Ce sont en fait à chaque fois des "dossiers de fichiers" au sens Explorateur Windows
Ces dossiers seront vides à leur création

Les termes "Répertoire" et "dossiers" que j'ai utilisés sont la même chose,
Je vous ai mis un exemple en pièce jointe : où j'aurais un dossier déjà existant nommé "Factures Clients" et dans lequel seront crées l'ensemble des dossiers à l'aide du fichier Excel.

Vous me répondrez que j'aurais pu les créer manuellement la 50taine de dossiers mais j'aurais préféré l'automatiser.

Edit : merci Phil69970, je ferai un test de votre proposition et reviens vers vous un peu plus tard dans la journée

Cordialement
 

Pièces jointes

  • Dossiers.png
    Dossiers.png
    8.4 KB · Affichages: 9

job75

XLDnaute Barbatruc
Bonjour à tous,

Avec cette solution on choisit le dossier devant recevoir les sous-dossiers :
VB:
Sub Creer_sous_dossiers()
Dim chemin$, tablo, i&, x$, n&
'---sélection du dossier---
ChDir ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = False Then Exit Sub
    chemin = .SelectedItems(1) & "\"
End With
'---création des sous-dossiers---
tablo = [Tableau1].Resize(, 3)
For i = 1 To UBound(tablo)
    x = chemin & tablo(i, 1) & "_" & tablo(i, 2) & "_" & tablo(i, 3)
    If Dir(x, vbDirectory) = "" Then MkDir x: n = n + 1
Next
MsgBox "Nombre de sous-dossiers créés : " & n
End Sub
A+
 

Pièces jointes

  • Dossiers Clients(1).xlsm
    18.8 KB · Affichages: 7

Amilo

XLDnaute Accro
Re,
Bonjour @job75,
Merci beaucoup, c'est exactement ce que je voulais, rien à dire :)

@Phil69970 , je viens de tester votre proposition,
Cela génère des fichiers Excel au lieu de dossiers, désolé mais probablement que mon 1er message n'était pas clair
Je suis certain que cela me servira ou à d'autres personnes un jour

Bonne fin de journée à tous

Cordialement
 

Amilo

XLDnaute Accro
Bonjour le forum,

Pour anticiper toute éventuelle modification de mon fichier .xlsm des Clients, j'ai testé plusieurs modèles et réussi à adapter sans problème le code à job75 notamment sur un tableau avec moins ou plus de colonnes.

Cependant, je n'ai pas réussi comment créer des dossiers avec une colonne "Condition"
J'ai ajouté à tout hasard un : And tablo(i, 4)="X" derrière le FOR i mais sans succès

VB:
For i = 1 To UBound(tablo)And tablo(i, 4)="X"

Pouvez-vous svp m'aider à adapter le code pour qu'il soit créé un dossier à chaque "X" ?

En vous remerciant par avance

Cordialement
 

Pièces jointes

  • Dossiers Clients_avec Condition.xlsm
    18.9 KB · Affichages: 2

job75

XLDnaute Barbatruc
Bonjour Amilo, kiki29, le fil,

A priori c'est simple en effet :
VB:
'---création des sous-dossiers---
tablo = [Tableau1].Resize(, 4)
For i = 1 To UBound(tablo)
    If UCase(tablo(i, 4)) = "X" Then
        x = chemin & tablo(i, 1) & "_" & tablo(i, 2) & "_" & tablo(i, 3)
        If Dir(x, vbDirectory) = "" Then MkDir x: n = n + 1
    End If
Next
Mais si après on efface un "X" que doit-il se passer ?

A+
 

job75

XLDnaute Barbatruc
Si l'on veut supprimer les sous-dossiers non cochés utiliser RmDir :
VB:
Sub Creer_sous_dossiers()
Dim chemin$, tablo, i&, x$, n&, p&
'---sélection du dossier---
ChDir ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = False Then Exit Sub
    chemin = .SelectedItems(1) & "\"
End With
'---création des sous-dossiers---
tablo = [Tableau1].Resize(, 4)
For i = 1 To UBound(tablo)
    x = chemin & tablo(i, 1) & "_" & tablo(i, 2) & "_" & tablo(i, 3)
    If UCase(tablo(i, 4)) = "X" Then
        If Dir(x, vbDirectory) = "" Then MkDir x: n = n + 1
    ElseIf Dir(x, vbDirectory) <> "" Then
        RmDir x: p = p + 1
    End If
Next
MsgBox "Nombre de sous-dossiers créés : " & n & _
    vbLf & "Nombre de sous-dossiers supprimés : " & p
End Sub
 

Pièces jointes

  • Dossiers Clients_avec Condition(1).xlsm
    19.5 KB · Affichages: 12

Amilo

XLDnaute Accro
Bonjour kiki29, job75,

@kiki29, merci pour ce lien, après lecture j'ai testé plusieurs boucles mais en vain :),
je suis un débutant en VBA

@job75 , merci encore pour votre aide et le code,
J'avais effectivement pensé à "If Then" mais pas au "End If" :(
Je note que le Ucase est pour les "X" en majuscule

Mais si après on efface un "X" que doit-il se passer ?

Sinon pour répondre à votre question :
j'ai un dossier qui sera crée annuellement 2021, 2022, 2023...etc et pour chaque année, j'aurais le dossier "Factures Clients" et les sous-dossiers "Clients"

Pour la création des dossiers, je partirai toujours du fichier .xlsm complet avec l'ensemble des Clients existants,
Pour éviter de créer l'ensemble des dossiers d'une année à l'autre et pour les clients avec qui nous ne travaillerons plus, je retire alors la coche.

Si j'exécute le code dans un même dossier de l'année afin d'ajouter de nouveaux clients, vos 2 premiers codes sont parfaits, cela ajoute uniquement les nouveaux "Clients" et ne duplique pas les dossiers des "Clients" déjà existants,

Si une cellule est décochée pour une raison ou une autre et que je lance le code, je veux qu'il ne se passe rien et qu'il ne me supprime pas le dossier déjà créé en cours d'année.

Edit : merci job75 pour votre dernier message avec une version de suppression des dossiers. Je pense qu'il ne me sera pas utile dans ce cas

Merci encore pour votre aide et bonne journée à tous

Cordialement
 
Dernière édition:

Discussions similaires

Réponses
11
Affichages
251

Statistiques des forums

Discussions
312 370
Messages
2 087 688
Membres
103 639
dernier inscrit
NIEMASAFI