macro pour creation de dossier

post prod

XLDnaute Occasionnel
bonjour a tous
jaimerai savoir si il est possible de faire une macro qui creer des dossier a partir d'une liste de nom
j'ai une liste de 300 noms de batiment et je dois creer 300 dossiers avec leur noms respectif
merci d'avance pour vos reponses
 

Pierrot93

XLDnaute Barbatruc
Re : macro pour creation de dossier

Re,

une petite boucle sur la colonne A, renverra un message d'erreur si dossier déjà existant ou si dans la cellule des noms qui ne peuvent pas être utilisés comme tel pour des dossiers...

Code:
Option Explicit
Sub test()
Dim i As Long
For i = 1 To Range("A65536").End(xlUp).Row
    MkDir "C:\Documents\" & Cells(i, 1).Value
Next i
End Sub

@+
 

C4rtoons

XLDnaute Junior
Re : macro pour creation de dossier

Bonsoir Pierrot,
Si je comprend bien, ta formule créée le dossier en fonction d'un nom dans la cellule (parfait c'est ce que je cherche à faire)
Par contre je voudrais que ma macro, enregistre mon fichier dans le dossier qu'elle vient de créer!
Actuellement mon fichier s'enregistre dans le chemin ci-dessous, et cela fonctionne à merveille!! Mais un dans un chemin bien défini à l'avance, pas dans le dossier que je viens de créer....
Code:
ActiveWorkbook.SaveAs Filename:="D:\Mes documents....

Est ce que tu peux m'aider sur ce point stp?

Merci à toi, bonne soirée.
 

kiki29

XLDnaute Barbatruc
Re : macro pour creation de dossier

Salut,une autre approche,à toi de l'adapter
Code:
Option Explicit

Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long


Private Sub CreationDossier(sDossier As String)
' Pour valeur retournée dans Rep
'   Voir http://msdn.microsoft.com/en-us/library/bb762131(VS.85).aspx
'   et   http://msdn.microsoft.com/en-us/library/ms681381(VS.85).aspx
Dim Rep As Long
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Sub

Sub Test()
Dim sDossier As String
    sDossier = "C:\Essai1\Essai2\Essai3\Essai4\Essai5"
    CreationDossier sDossier
End Sub
 

Kiriko

XLDnaute Occasionnel
Re : macro pour creation de dossier

Bonjour à tous !
Je déterre ce vieux post car mon problème est assez similaire.
Je souhaite créer des arborescences de répertoires en partant d'un tableau excel; Le principe étant que C1 est un sous-dossier de B1 qui est un sous-dossier de A1 (et ainsi de suite pour les lignes suivantes. J'ai essayé en bidouillant les codes fournis, et en tentant de "concaténer" en interposant des "\" mais je n'y arrive pas... Si quelqu'un a une piste pour m'aider.... (exemple de tableau en PJ)

Par avance, merci !!
 

Pièces jointes

  • Pour création dossiers V2.xls
    19.5 KB · Affichages: 335
Dernière édition:

kiki29

XLDnaute Barbatruc
Salut, Pas la moindre trace de code dans ton classeur ?
A adapter à ton contexte
Code:
Option Explicit

Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long

Sub Tst()
Dim LastRow As Long
Dim i As Long
Dim sDossier As String
Dim sDossier1 As String
Dim sDossier2 As String
Dim sDossier3 As String

    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LastRow
        sDossier1 = Feuil1.Range("A" & i)
        sDossier2 = Feuil1.Range("B" & i)
        sDossier3 = Feuil1.Range("C" & i)
        sDossier = "C:\" & sDossier1 & "\" & sDossier2 & "\" & sDossier3
        
        If NomValide(sDossier1) And NomValide(sDossier2) And NomValide(sDossier3) Then
            CreationDossier sDossier
            Feuil1.Range("D" & i).Interior.ColorIndex = xlNone
        Else
            Feuil1.Range("D" & i).Interior.ColorIndex = 3
        End If
    Next i
End Sub

Private Sub CreationDossier(sDossier As String)
Dim Rep As Long
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Sub

Private Function NomValide(sChaine As String) As Boolean
Dim i As Long
Const CaracInterdits As String = """*/:<>?[\]|"
    
    NomValide = True
    For i = 1 To Len(CaracInterdits)
        If InStr(sChaine, Mid$(CaracInterdits, i, 1)) > 0 Then
            NomValide = False
            Exit Function
        End If
    Next i
End Function
 
Dernière édition:

Kiriko

XLDnaute Occasionnel
Re : Re: macro pour creation de dossier

Bonjour, kiki29 !
Mille merci, c'est plus que parfait !
Ayant consulté de nombreux posts sur des sujets approchants, je ne trouvais pas comment les adapter (faut dire que mon niveau est très bas aussi).
Je suis impressionné par la qualité du résultat du 1er coup et surtout de ta rapidité.....
J'ai une énorme structure de dossiers à monter, et là, ça va passer tout seul....
Encore Merci !!!!
 

Marc64

XLDnaute Nouveau
Re : macro pour creation de dossier

Bonjour,

J'ai une autre demande lié à cette macro. J'ai effectué un classement par niveau ex: 1 ; 10 ; 101; ...
J'ai utilisé la macro pour créer les dossier et sous dossier, cependant étant débutant en VBA je ne trouve pas comment faire pour changer les nom des sous-dossier automatiquement.
Colonne A, B, C, D, E, F, G sont les sous niveaux présenté ci-dessus. La colonne I présente les nom associés aux numéros.

Pouvez vous m'aider?

Merci d'avance.
 

Discussions similaires

Réponses
5
Affichages
113