renommer un dossier.

**HABILER** · 23/10/2019, 19h48

J'ai une directory C:\ pers\ & !NomName & "\A. Pieces officielles\".

Je voudrais que si les dossiers comportant \A. mais ne s'intitulant pas \A. Pieces officielles\" soient remplacés par \A. Pieces officielles\"
J'ai écrit un code dont une ârtie est reprise ci dessous. mais il me crée un secont dossier vide.

Code :

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

1
2
3
4
5
6
7
8
9
10
            strPathNl = toPath & "\" & !NomName & "\A. Pieces officielles\"
 
                If fso.FileExists(strPathNl) = False Then
                MkDir strPathNl
                Else
                If Mid(strPathNl, longstrPath, 2) = "A." And fso.FileExists(strPathNl) = False Then
                MkDir strPathNl
                fso.CopyFolder strPathNl, strPathNl
                End If
            End If

**Zekraoui_Jakani** · 24/10/2019, 13h11

Essayez ceci:

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
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 newName As String
    Dim strPathNl As String
 
    strPathNl = toPath & "\" & !NomName & "\" '. Pieces officielles\"
    newName = "A. Pieces officielles"
 
    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 newName Then
                Folder.Name = newName
                'vérifier si l'on ne traite pas le même répertoire plus d'une fois !!
                If Folder.Name <> newName Then Folder.Name = newName
            End If
        End If
    Next Folder
 
    Set objFSO = Nothing
    Set mySource = Nothing
 
End Sub

**HABILER** · 25/10/2019, 12h26

Merci pour ta réponse. En ai profité pour l adapter à une partie de mes besoins.

Mais si le folder n'existe n'existe puis je utiliser un Mkdir NewNameA.

La procderere est elle la meme pur les sous folder et enfin
Ne serait-il pas plus clair d'utiliser d-une fonction car j'ai peur que le code soit trop charge.

J'ai des folders jusque "J."
Et des sous folders jusque 12. (\J. abc\12. def)

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
46
47
48
49
50
51
52
Option Compare Database
 
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 newName As String
    Dim strPathNl As String
    Dim strSql As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    toPath = "C:\Pers1"
 
    Set dbs = CurrentDb
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder("C:\Pers1\")
    strSql = "SELECT Matr, NomName, NomName,NomNameMatr, Languagecode FROM DEC WHERE Matr = 2983"
    Set rst = dbs.OpenRecordset(strSql, dbOpenSnapshot, dbFailOnError)
 
    strPathNl = f & "\" & rst!NomName & "\" '. Pieces officielles\"
    newNameA = "A. Pieces officielles de recrutement"
    newNameB = "B. Pro"
    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
   ' Next Folder
        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

**HABILER** · 27/10/2019, 09h32

Voila j'ai tenté un truc qui m'indique une erreur du i

Code :

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

  MkDir (strPathNl) & newNameA & "\" & newNameA&i & "\"

.
Le code attend une fin d'instruction.

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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
 
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 newName As String
    Dim strPathNl As String
    Dim strSql As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim i As Long
    toPath = "C:\Pers1"
 
    newNameA = "A. Pieces officielles"
            newNameA1 = "1. P1"
            newNameA2 = "2. Werfbundel"
            newNameA3 = "3. Overige"
            newNameA4 = "4. Contracten"
            newNameA5 = "5. Wijzigingen"
 
    newNameB = "B. Promotions"
 
 
 
    Set dbs = CurrentDb
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder("C:\Pers1\")
    strSql = "SELECT Matr, NomName, NomName,NomNameMatr, Languagecode FROM DEC WHERE Matr = 3500"
    Set rst = dbs.OpenRecordset(strSql, dbOpenSnapshot, dbFailOnError)
 
    strPathNl = toPath & "\" & rst!NomName & "\" '. Pieces officielles\"
 
          If Dir(strPathNl, vbDirectory) = "" Then
 
                 MsgBox "Le r?pertoire n'existe pas"
                 MkDir (strPathNl)
                 MkDir (strPathNl) & newNameA
 
                 For i = 1 To 5
                 i = i + 1
 
                                  MkDir (strPathNl) & newNameA & "\" & newNameA&i & "\"
                                 ' MkDir (strPathNl) & newNameA & "\" & newNameA2 & "\"
                                 ' MkDir (strPathNl) & newNameA & "\" & newNameA3 & "\"
                                 ' MkDir (strPathNl) & newNameA & "\" & newNameA4 & "\"
                                 ' MkDir (strPathNl) & newNameA & "\" & newNameA5 & "\"
                 Next
                 MkDir (strPathNl) & newNameB
         Else
                 MsgBox "Le r?pertoire existe"
         End If
 
 
 
    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 newName Then
                Folder.Name = newName
                'v?rifier si l'on ne traite pas le m?me r?pertoire plus d'une fois !!
                If Folder.Name <> newName Then Folder.Name = newName
            End If
        End If
 
    Next Folder
 
    Set objFSO = Nothing
    Set mySource = Nothing
 
End Sub

**HABILER** · 29/10/2019, 12h45

Bonjour a tous

Mon

Code :

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

Root2 & "\" & varFldrsRoot1(i)

se plante si le dossier existe. Je voudrais le bypasser s'il existe.

Merci d'avance a tous

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
46
47
48
49
50
51
52
Option Compare Database
Option Explicit
 
Sub Verifier_Presence_Sous_Dossier()
    Dim Pth As String
    Dim i As Integer
    Dim strSql As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim fs As FileSystemObject
    Dim mySource As Object
    Dim Folder As Variant
    Dim fso As Object
    Set dbs = CurrentDb
    Dim Root1 As String, Root2 As String, Root3 As String
    Dim NewName As String
    Dim varFldrsRoot1 As Variant
 
    Set dbs = CurrentDb
    strSql = "SELECT DEC.Matr, DEC.NomName, DEC.NomNameMatr, DEC.NomNameMatrk, DEC.Languagecode FROM [DEC] WHERE (((DEC.Languagecode)=1) AND ((DEC.[Matr])=3478 Or (DEC.[Matr])=105185 Or (DEC.[Matr])=5363));"
    Set rst = dbs.OpenRecordset(strSql, dbOpenSnapshot, dbFailOnError)
 
    Pth = "F:\Pers\"  'Path to the top folder with trailing slash
 
 
    Root1 = Pth & rst!NomName
    Root2 = Root1 & "\" & "J. Fin du contrat"
    'Root3 = Root1 & "B. Promotions"
 
    If Len(Dir(Root1, vbDirectory)) = 0 Then
 
        MkDir Root1
 
    End If
 
    If Len(Dir(Root2, vbDirectory)) = 0 Then
 
        MkDir Root2
 
    End If
 
    varFldrsRoot1 = Split("1. Dispo retraite anticipée et rappel en service,2. Pension,3. demission,4. Fiche B2,5. Autre", ",")
 
    For i = 0 To UBound(varFldrsRoot1)
 
        If Len(Dir(Root2 & "\" & varFldrsRoot1(i), vbDirectory)) = 0 Then
 
        MkDir Root2 & "\" & varFldrsRoot1(i)
        End If
  Next i
 
End Sub

renommer un dossier.

VBA Access

Discussions similaires

Partager

Partager