Discussion :

[dberna]

Bonjour,

J'ai besoin d'aide de votre part sur un fichier Excel qui permet de générer des répertoires et sous répertoires. J'ai essayé de fouiller dans le forum mais je ne trouve pas pourquoi ça ne marche pas.

Pour être plus précis dans mon fichier Excel (en bas du message) , j'aimerai générer des répertoires à partir des cellules F19 à AK(cellule la plus basse). Dans ces cellules j'ai les adresses des répertoires à créer.

Dans ma macro2, je fais juste le test avec les cellules F19 à AK19 et j'ai la moitié de mes répertoires créés. Je ne comprends pas...

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
On Error Resume Next
 For Each C In Range("F19:AK19")
 MkDir "C:\Users\BERNARD.DA\Documents\Dossier_racine\" & C.Value
 Next

Pouvez-vous m'aider?



template création répertoires dans dossier racine test.xlsm

[kiki29]

Salut, à adapter à ton contexte

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
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 Function CreationDossier(sDossier) As Long
Dim Rep As Long
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Function
 
Sub Tst()
Dim sDossier As String
    sDossier = "C:\Essai1\Essai2\Essai3\Essai4\Essai5"
    CreationDossier sDossier
End Sub

En espérant qu'il n'y ait pas de caractères interdits dans tes noms de fichiers, car avec un on error resume next tu ne verras rien ..... Donc déjà à supprimer.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const sCaracInterdits As String = """*/:<>?[\]|"
    NomFichierValide = True
    If Len(sChaine) = 0 Then
        NomFichierValide = False
        Exit Function
    End If
    For i = 1 To Len(sCaracInterdits)
        If InStr(sChaine, Mid$(sCaracInterdits, i, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next i
End Function

[dberna]

Salut,

Merci pour ta réponse.
Je suis embêté car je ne suis pas assez calé en VBA pour comprendre et adapter ton code à mon fichier.
Je ne vois pas de fonction mkdir dans ton code. Je ne vois pas comment mettre ma plage F12 - AK12 dans ton code.
Pourrais-tu m'aider encore?

Merci beaucoup

[kiki29]

Salut, qqch comme ceci, à adapter à ton contexte

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub Tst()
Dim sDossier As String, c As Range
    For Each c In Feuil1.Range("F19:AK19")
        sDossier = ThisWorkbook.Path & "\" & c.Text
        CreationDossier sDossier
    Next c
End Sub

[dberna]

Merci pour ta réponse

Voici la réponse la plus adaptée à mon problème:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub CreaRep()
Dim i&, K&, Col%, MaxLigne&
Dim MonChemin$, SousDossier$
Dim Tmp As Variant
 
'MonChemin = Bureau pour les tests
'MonChemin = CreateObject("WScript.Shell").specialFolders("Desktop") & "\"
 
 
With Sheets("Calcul")
    MaxLigne = .Cells.Find("*", Cells(.Rows.Count, .Columns.Count), xlValues, , 1, 2, 0).Row
    For i = 19 To MaxLigne
        'Pour les colonnes de F à AK
        For Col = 6 To 37
            If .Cells(i, Col) <> "" Then
                Tmp = Split(.Cells(i, Col), "\")
                SousDossier = MonChemin
                For K = LBound(Tmp) To UBound(Tmp)
                    SousDossier = SousDossier & Tmp(K) & "\"
                    'Si le dossier n'existe pas
                    If Dir(SousDossier, vbDirectory) = "" Then
                    'creation du dossier
                        MkDir SousDossier
                    End If
                Next K
            End If
        Next Col
    Next i
End With
End Sub

Cordialement

[kiki29]

Salut, il n'est pas interdit de baliser son code, ni de l'indenter.