Discussion :

[HABILER]

Bonjour lors d'une discussion précedente j'ai reçu le code suivant pour renommer un dossier.
Je voudrais faire la même chose avec des sous dossiers et les créer s'ils n'existent pas

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
 
Sub RenommerDossier()
'si les dossiers comportant \A.
'mais ne s'intitulant pas \A. Pieces officielles\"
'soient remplacés par \A. Pieces officielles\"
 
    'Préalable: vérifier si les référence nécessaires au FileSystemObject sont activées.
    Dim objFSO As FileSystemObject
    Dim mySource As Object
    Dim Folder As Variant
    Dim newNameA As String
    Dim newNameB As String
    Dim strPathNl As String
 
    strPathNl = toPath & "\" & !NomName & "\" '. Pieces officielles\"
    newNameA = "A. Pieces officielles"
    newNameB = "B. Promotions
"
    Set objFSO = New FileSystemObject
    Set mySource = objFSO.GetFolder(strPathNl)
 
    For Each Folder In mySource.SubFolders
        If InStr(1, Folder.Name, "A.") > 0 Then
            If Not Folder.Name Like newNameA  Then
                Folder.Name = newNameA 
                'vérifier si l'on ne traite pas le même répertoire plus d'une fois !!
                If Folder.Name <> newNameA  Then Folder.Name = newNameA 
            End If
        End If
 
        If InStr(1, Folder.Name, "B.") > 0 Then
            If Not Folder.Name Like newNameB Then
                Folder.Name = newNameB
                'vérifier si l'on ne traite pas le même répertoire plus d'une fois !!
                If Folder.Name <> newNameB Then Folder.Name = newNameB
            End If
        End If
 
 
    Next Folder
 
    Set objFSO = Nothing
    Set mySource = Nothing
 
End Sub

[Zekraoui_Jakani]

Il suffit d'indiquer le nom du sous-dossier ainsi:

Code :

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

strPathNl = toPath & "\" & NomSousDossier & "\" & !NomName & "\"

Pour savoir si "toPath & "\" & NomSousDossier" existe:

Code :

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

1
2
3
If Len(toPath & "\" & NomSousDossier)=0 then
   MkDir toPath & "\" & NomSousDossier
End If