macro pour creation de dossier

[post prod]

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]

Re : macro pour creation de dossier

Bonjour,

regarde du coté de l'instruction "MkDir"... touche de fonction F1 sur ce mot dans l'éditeur vba, te donnera plus des infos.

bon après midi
@+

 

[Pierrot93]

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

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]

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

ActiveWorkbook.SaveAs Filename:="D:\Mes documents....

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

Merci à toi, bonne soirée.

 

[kiki29]

Re : macro pour creation de dossier

Salut,une autre approche,à toi de l'adapter

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

 

[C4rtoons]

Re : macro pour creation de dossier

Je ne comprends pas trop ce que fait la macro...
Tu pourrais essayer de me détailler par étapes ce que cela génère? Le Shell32.dll par exemple?!
Merci 🙂

 

[Kiriko]

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

 

[kiki29]

Salut, Pas la moindre trace de code dans ton classeur ?
A adapter à ton contexte

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

 

[Kiriko]

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]

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.