Création et deplacement de dossiers d'archivage suivant liste excel

**pm-pr** · 21/09/2018, 15h44

Bonjour,
Je débute en programmation et j'ai pour mission de créer des dossiers d'archivage en fonction d'une liste de dossiers sous Excel 2013. Je m'arrache un peu les cheveux; c'est compliqué et c'est pourquoi je viens solliciter votre aide s'il vous plait.

Ci-joint mon fichier Excel dans lequel on retrouve la liste des dossiers (de 1 à 9). je souhaite que ma macro créé un dossier par ligne, chaque dossier nommé 'indice' & 'numéro de dossier' & 'client'. j'ai réussis à faire cela avec le code suivant :

Code :

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

1
2
3
4
5
6
7
8
9
10
Public Sub Creation_repertoire2()
Dim lig As Long
On Error Resume Next
MkDir "Y:\Fab\en cours"
For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row
MkDir "Y:\Fab\en cours\" & Cells(lig, "A").Value _
        & Cells(lig, "B").Value _
        & ";" & Cells(lig, "C").Value
Next
End Sub

ce code fonctionne sauf que je souhaite y apporter la modification suivante :
pour chaque ligne,
- si la colonne D n'est pas vide et si le dossier existe déjà dans "Y:\Fab\en cours" alors déplacer le dossier dans "Y:\Fab\terminé"
- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il existe dans "Y:\Fab\terminé" alors ne rien faire
- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il n'existe pas dans "Y:\Fab\terminé" alors créer le dossier dans "Y:\Fab\terminé"
- si la colonne D est vide et que le dossier existe déjà dans "Y:\Fab\en cours" alors ne rien faire
- si la colonne D est vide et que le dossier n'existe pas dans "Y:\Fab\en cours" alors créer le dossier dans "Y:\Fab\en cours"

j'espère avoir été à peu près clair dans mes explications.

merci d'avance pour votre aide.

**patricktoulon** · 21/09/2018, 17h59

bonjour

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
'1°- si la colonne D n'est pas vide et si le dossier existe déjà dans "Y:\Fab\en cours" alors déplacer le dossier dans "Y:\Fab\terminé"
'2°- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il existe dans "Y:\Fab\terminé" alors ne rien faire
'3°- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il n'existe pas dans "Y:\Fab\terminé" alors créer le dossier dans "Y:\Fab\terminé"
'4°- si la colonne D est vide et que le dossier existe déjà dans "Y:\Fab\en cours" alors ne rien faire
'5°- si la colonne D est vide et que le dossier n'existe pas dans "Y:\Fab\en cours" alors créer le dossier dans "Y:\Fab\en cours"
Public Sub Creation_repertoire2()
    With Sheets("Feuil1")
        Dim lig&, fso As Object,rep$,zero$':):):)
        Set fso = CreateObject("Scripting.FileSystemObject")
        On Error Resume Next
        MkDir "Y:\Fab\en cours"
        err.clear
        For lig = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            dossier = Cells(lig, "A").Value & Cells(lig, "B").Value & "-" & Cells(lig, "C").Value
 
            '   1°- si la colonne D n'est pas vide et si le dossier existe déjà dans "Y:\Fab\en cours" alors déplacer le dossier dans "Y:\Fab\terminé"
            If Cells(i, "D") <> "" And Dir("Y:\Fab\en cours\" & dossier, vbDirectory) <> "" Then
                fso.copyfolder "Y:\Fab\en cours\" & dossier, "Y:\Fab\terminé\" & dossier
                rep = "Y:\Fab\en cours\" & dossier
                fso.DeleteFolder rep
 
                '2°- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il existe dans "Y:\Fab\terminé" alors ne rien faire
            ElseIf Cells(i, "D") <> "" And Dir("Y:\Fab\en cours\" & dossier, vbDirectory) = "" Then
                zero = "la tete a toto"  'ben rien d'accords :)
 
                '3°- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il n'existe pas dans "Y:\Fab\terminé" alors créer le dossier dans "Y:\Fab\terminé"
            ElseIf Cells(i, "D") <> "" And Dir("Y:\Fab\en cours\" & dossier, vbDirectory) = "" And Dir("Y:\Fab\terminé\" & dossier) = "" Then MkDir ("Y:\Fab\terminé\" & dossier)
 
                '4°- si la colonne D est vide et que le dossier existe déjà dans "Y:\Fab\en cours" alors ne rien faire
            ElseIf Cells(i, "D") = "" And Dir("Y:\Fab\en cours\" & dossier, vbDirectory) <> "" Then
                zero = "la tete a toto"  'ben rien d'accords :)
 
                '5°- si la colonne D est vide et que le dossier n'existe pas dans "Y:\Fab\en cours" alors créer le dossier dans "Y:\Fab\en cours"
            ElseIf Cells(i, "D") <> "" And Dir("Y:\Fab\en cours\" & dossier, vbDirectory) = "" Then MkDir ("Y:\Fab\en cours\" & dossier)
 
            End If
 
        End With
Set fso=nothing
    End Sub

j'ai changé ton ";" en "-" dans le nom du dossier
if aut que au moins tes dossiers ("Y:\Fab") et ("Y:\Fab\terminé") existe sinon walouh

**Jean-Philippe André** · 21/09/2018, 18h18

Salut,

attention le 5 est faux dans la solution de Patrick

Code :

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

1
2
'5°- si la colonne D est vide et que le dossier n'existe pas dans "Y:\Fab\en cours" alors créer le dossier dans "Y:\Fab\en cours"
            ElseIf Cells(i, "D") <> "" And Dir("Y:\Fab\en cours\" & dossier, vbDirectory) = "" Then MkDir ("Y:\Fab\en cours\" & dossier)

à remplacer par

Code :

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

1
2
3
'5°- si la colonne D est vide et que le dossier n'existe pas dans "Y:\Fab\en cours" alors créer le dossier dans "Y:\Fab\en cours"
            ElseIf Cells(i, "D") = "" And Dir("Y:\Fab\en cours\" & dossier, vbDirectory) = "" Then 
MkDir ("Y:\Fab\en cours\" & dossier)

**patricktoulon** · 21/09/2018, 18h21

re
merci Jean-Philippe-André j'ai du m'enmeller les pinceaux

peut etre que comme ca sa eclairci le code

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
'- si la colonne D n'est pas vide et si le dossier existe déjà dans "Y:\Fab\en cours" alors déplacer le dossier dans "Y:\Fab\terminé"
'- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il existe dans "Y:\Fab\terminé" alors ne rien faire
'- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il n'existe pas dans "Y:\Fab\terminé" alors créer le dossier dans "Y:\Fab\terminé"
'- si la colonne D est vide et que le dossier existe déjà dans "Y:\Fab\en cours" alors ne rien faire
'- si la colonne D est vide et que le dossier n'existe pas dans "Y:\Fab\en cours" alors créer le dossier dans "Y:\Fab\en cours"
Public Sub Creation_repertoire2()
    With Sheets("Feuil1")
        Dim lig&, fso As Object, lig&, dossier$, rep$, zero$, dossier_en_cours As Boolean, dossier_en_terminé As Boolean ':):)
        Set fso = CreateObject("Scripting.FileSystemObject")
        On Error Resume Next
        MkDir "Y:\Fab\en cours"
        For lig = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
 
            dossier = Cells(lig, "A").Value & Cells(lig, "B").Value & "-" & Cells(lig, "C").Value
 
            dossier_en_cours = Dir("Y:\Fab\en cours\" & dossier, vbDirectory) <> ""
            dossier_en_terminé = Dir("Y:\Fab\terminé\" & dossier, vbDirectory) <> ""
            '   1°- si la colonne D n'est pas vide et si le dossier existe déjà dans "Y:\Fab\en cours" alors déplacer le dossier dans "Y:\Fab\terminé"
            If Cells(i, "D") <> "" And dossier_en_cours Then
                fso.copyfolder "Y:\Fab\en cours\" & dossier, "Y:\Fab\terminé\" & dossier
                rep = "Y:\Fab\en cours\" & dossier
                fso.DeleteFolder rep
 
                '2°- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il existe dans "Y:\Fab\terminé" alors ne rien faire
            ElseIf Cells(i, "D") <> "" And Not dossier_en_cours Then
                zero = "la tete a toto"  'ben rien d'accords :)
 
                '3°- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il n'existe pas dans "Y:\Fab\terminé" alors créer le dossier dans "Y:\Fab\terminé"
            ElseIf Cells(i, "D") <> "" And Not dossier_en_cours And Not dossier_en_terminé Then MkDir ("Y:\Fab\terminé\" & dossier)
 
                '4°- si la colonne D est vide et que le dossier existe déjà dans "Y:\Fab\en cours" alors ne rien faire
            ElseIf Cells(i, "D") = "" And dossier_en_cours Then
                zero = "la tete a toto"  'ben rien d'accords :)
 
                '5°- si la colonne D est vide et que le dossier n'existe pas dans "Y:\Fab\en cours" alors créer le dossier dans "Y:\Fab\en cours"
            ElseIf Cells(i, "D") ="" And Not dossier_en_cours Then MkDir ("Y:\Fab\en cours\" & dossier)
 
            End If
 
        End With
 
    End Sub

**pm-pr** · 21/09/2018, 19h00

merci pour la réponse rapide, par contre j'ai un message d'erreur :
end with sans with

**patricktoulon** · 21/09/2018, 19h03

a oui il y a un "next qui a sauté j'ai pas compris la ?????

bon....

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
'- si la colonne D n'est pas vide et si le dossier existe déjà dans "Y:\Fab\en cours" alors déplacer le dossier dans "Y:\Fab\terminé"
'- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il existe dans "Y:\Fab\terminé" alors ne rien faire
'- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il n'existe pas dans "Y:\Fab\terminé" alors créer le dossier dans "Y:\Fab\terminé"
'- si la colonne D est vide et que le dossier existe déjà dans "Y:\Fab\en cours" alors ne rien faire
'- si la colonne D est vide et que le dossier n'existe pas dans "Y:\Fab\en cours" alors créer le dossier dans "Y:\Fab\en cours"
Public Sub Creation_repertoire2()
    With Sheets("Feuil1")
        Dim lig&, fso As Object, lig&, dossier$, rep$, zero$, dossier_en_cours As Boolean, dossier_en_terminé As Boolean    ':):)
        Set fso = CreateObject("Scripting.FileSystemObject")
        On Error Resume Next
        MkDir "Y:\Fab\en cours"
        For lig = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            dossier = Cells(lig, "A").Value & Cells(lig, "B").Value & "-" & Cells(lig, "C").Value
            dossier_en_cours = Dir("Y:\Fab\en cours\" & dossier, vbDirectory) <> ""
            dossier_en_terminé = Dir("Y:\Fab\terminé\" & dossier, vbDirectory) <> ""
 
            '   1°- si la colonne D n'est pas vide et si le dossier existe déjà dans "Y:\Fab\en cours" alors déplacer le dossier dans "Y:\Fab\terminé"
            If Cells(i, "D") <> "" And dossier_en_cours Then
                fso.copyfolder "Y:\Fab\en cours\" & dossier, "Y:\Fab\terminé\" & dossier
                rep = "Y:\Fab\en cours\" & dossier
                fso.DeleteFolder rep
 
                '2°- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il existe dans "Y:\Fab\terminé" alors ne rien faire
            ElseIf Cells(i, "D") <> "" And Not dossier_en_cours And Not dossier_en_terminé Then
                zero = "la tete a toto"  'ben rien d'accords :)
 
                '3°- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il n'existe pas dans "Y:\Fab\terminé" alors créer le dossier dans "Y:\Fab\terminé"
            ElseIf Cells(i, "D") <> "" And Not dossier_en_cours And Not dossier_en_terminé Then MkDir ("Y:\Fab\terminé\" & dossier)
 
                '4°- si la colonne D est vide et que le dossier existe déjà dans "Y:\Fab\en cours" alors ne rien faire
            ElseIf Cells(i, "D") = "" And dossier_en_cours Then
                zero = "la tete a toto"  'ben rien d'accords :)
 
                '5°- si la colonne D est vide et que le dossier n'existe pas dans "Y:\Fab\en cours" alors créer le dossier dans "Y:\Fab\en cours"
            ElseIf Cells(i, "D") = "" And Not dossier_en_cours Then MkDir ("Y:\Fab\en cours\" & dossier)
 
            End If
        Next
    End With
 
End Sub

ps:petite correction faite

**pm-pr** · 21/09/2018, 19h12

j'ai désormais une erreur de compilation : déclaration existante de la portée en cours
l'erreur pointée est au niveau de "lig&" ligne 3

**patricktoulon** · 21/09/2018, 19h16

re

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
'- si la colonne D n'est pas vide et si le dossier existe déjà dans "Y:\Fab\en cours" alors déplacer le dossier dans "Y:\Fab\terminé"
'- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il existe dans "Y:\Fab\terminé" alors ne rien faire
'- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il n'existe pas dans "Y:\Fab\terminé" alors créer le dossier dans "Y:\Fab\terminé"
'- si la colonne D est vide et que le dossier existe déjà dans "Y:\Fab\en cours" alors ne rien faire
'- si la colonne D est vide et que le dossier n'existe pas dans "Y:\Fab\en cours" alors créer le dossier dans "Y:\Fab\en cours"
Public Sub Creation_repertoire2()
    With Sheets("Feuil1")
        Dim lig&, fso As Object, dossier$, rep$, zero$, dossier_en_cours As Boolean, dossier_en_terminé As Boolean     ':):)
        Set fso = CreateObject("Scripting.FileSystemObject")
        On Error Resume Next
        MkDir "Y:\Fab\en cours"
        For lig = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            dossier = Cells(lig, "A").Value & Cells(lig, "B").Value & "-" & Cells(lig, "C").Value
            dossier_en_cours = Dir("Y:\Fab\en cours\" & dossier, vbDirectory) <> ""
            dossier_en_terminé = Dir("Y:\Fab\terminé\" & dossier, vbDirectory) <> ""
 
            '   1°- si la colonne D n'est pas vide et si le dossier existe déjà dans "Y:\Fab\en cours" alors déplacer le dossier dans "Y:\Fab\terminé"
            If Cells(i, "D") <> "" And dossier_en_cours Then
                fso.copyfolder "Y:\Fab\en cours\" & dossier, "Y:\Fab\terminé\" & dossier
                rep = "Y:\Fab\en cours\" & dossier
                fso.DeleteFolder rep
 
                '2°- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il existe dans "Y:\Fab\terminé" alors ne rien faire
            ElseIf Cells(i, "D") <> "" And Not dossier_en_cours And Not dossier_en_terminé Then
                zero = "la tete a toto"  'ben rien d'accords :)
 
                '3°- si la colonne D n'est pas vide et que le dossier n'existe pas dans "Y:\Fab\en cours" et qu'il n'existe pas dans "Y:\Fab\terminé" alors créer le dossier dans "Y:\Fab\terminé"
            ElseIf Cells(i, "D") <> "" And Not dossier_en_cours And Not dossier_en_terminé Then MkDir ("Y:\Fab\terminé\" & dossier)
 
                '4°- si la colonne D est vide et que le dossier existe déjà dans "Y:\Fab\en cours" alors ne rien faire
            ElseIf Cells(i, "D") = "" And dossier_en_cours Then
                zero = "la tete a toto"  'ben rien d'accords :)
 
                '5°- si la colonne D est vide et que le dossier n'existe pas dans "Y:\Fab\en cours" alors créer le dossier dans "Y:\Fab\en cours"
            ElseIf Cells(i, "D") = "" And Not dossier_en_cours Then MkDir ("Y:\Fab\en cours\" & dossier)
 
            End If
        Next
    End With
 
End Sub

**Jean-Philippe André** · 21/09/2018, 19h18

Essayons au moins de tout corriger en une seule fois

**patricktoulon** · 21/09/2018, 19h20

re
c'est bon j'ai testé avec un autre chemin pour corespondre a mon pc et disque dur ca match

**pm-pr** · 21/09/2018, 19h34

je suis désolé mais malheureusement il ne se passe rien lorsque je lance la macro.
je reprendrai ça lundi

**Jean-Philippe André** · 21/09/2018, 19h55

Je t'invite à retirer la ligne

Code :

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

On Error Resume Next

qui t'empêche de travailler convenablement dans ton contexte.

**patricktoulon** · 21/09/2018, 21h43

j'ai remarqué quelques difference entre 2007 et 2013
en effet avec 2013 ca fait rien

les deux test "<>""de dir ne fonctionnait pas sur 2013 j'ai du passer par like"*.*"
ainsi que "if not dossier_en_cours" pour tester le false j'ai du revenir a "if dossier_en_cours =false" et pareil pour le dossier terminé
un doevents sur 2013 semble etre necessaire
j'ai variabilisé les chemin de base et creation si il n'existent pas
de ce fait j'ai viré ta gestion d'erreur

va savoir

donc voila celle ci fonctionne chez moi pour 2007 et 2013

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
'- si la colonne D n'est pas vide et si le dossier existe déjà dans "L:\Fab\en cours" alors déplacer le dossier dans "L:\Fab\terminé"
'- si la colonne D n'est pas vide et que le dossier n'existe pas dans "L:\Fab\en cours" et qu'il existe dans "L:\Fab\terminé" alors ne rien faire
'- si la colonne D n'est pas vide et que le dossier n'existe pas dans "L:\Fab\en cours" et qu'il n'existe pas dans "L:\Fab\terminé" alors créer le dossier dans "L:\Fab\terminé"
'- si la colonne D est vide et que le dossier existe déjà dans "L:\Fab\en cours" alors ne rien faire
'- si la colonne D est vide et que le dossier n'existe pas dans "L:\Fab\en cours" alors créer le dossier dans "L:\Fab\en cours"
Public Sub Creation_repertoire2()
    With Sheets(1)
        Dim lig&, fso As Object, dossier$, rep$, zero$, dossier_en_cours As Boolean, dossier_en_terminé As Boolean, CH_encours$, CH_terminé$   ':):)
        Set fso = CreateObject("Scripting.FileSystemObject")
        CH_encours = "Y:\Fab\en cours"    ' a adapter a ton cas SI C EST PAS CA
        CH_terminé = "Y:\Fab\terminé"    ' a adapter a ton cas SI C EST PAS CA
 
        If Dir(CH_encours, vbDirectory) = "" Then MkDir CH_encours    ' au cas ou inexistant
        If Dir(CH_terminé, vbDirectory) = "" Then MkDir CH_terminé    ' au cas ou inexistant
 
        For lig = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            DoEvents
            dossier = Cells(lig, "A").Value & Cells(lig, "B").Value & "-" & Cells(lig, "C").Value    'concatenation du nom de dossier
            dossier_en_cours = Dir(CH_encours & "\" & dossier, vbDirectory) Like "*.*"    'existence(true/false)
            dossier_en_terminé = Dir(CH_terminé & "\" & dossier, vbDirectory) Like "*.*"    'existence(true/false)
 
            '   1°- si la colonne D n'est pas vide et si le dossier existe déjà dans "L:\Fab\en cours" alors déplacer le dossier dans "L:\Fab\terminé"
            If Cells(lig, "D").Text <> "" And dossier_en_cours = True Then
                fso.copyfolder CH_encours & "\" & dossier, CH_terminé & "\" & dossier
                rep = "L:\Fab\en cours\" & dossier
                fso.DeleteFolder rep
 
                '2°- si la colonne D n'est pas vide et que le dossier n'existe pas dans "L:\Fab\en cours" et qu'il existe dans "L:\Fab\terminé" alors ne rien faire
            ElseIf Cells(lig, "D").Value <> "" And dossier_en_cours = False And dossier_en_terminé = True Then
                zero = "la tete a toto"  'ben rien d'accords :)
 
                '3°- si la colonne D n'est pas vide et que le dossier n'existe pas dans "L:\Fab\en cours" et qu'il n'existe pas dans "L:\Fab\terminé" alors créer le dossier dans "L:\Fab\terminé"
            ElseIf Cells(lig, "D").Value <> "" And dossier_en_cours = False And dossier_en_terminé = False Then MkDir (CH_terminé & "\" & dossier)
 
                '4°- si la colonne D est vide et que le dossier existe déjà dans "L:\Fab\en cours" alors ne rien faire
            ElseIf Cells(lig, "D").Value = "" And dossier_en_cours = True Then
                zero = "la tete a toto"  'ben rien d'accords :)
 
                '5°- si la colonne D est vide et que le dossier n'existe pas dans "L:\Fab\en cours" alors créer le dossier dans "L:\Fab\en cours"
            ElseIf Cells(lig, "D").Value = "" And dossier_en_cours = False Then MkDir (CH_encours & "\" & dossier)
 
            End If
        Next
    End With
 
End Sub

**pm-pr** · 24/09/2018, 09h52

Bonjour patricktoulon,

je viens de tester cette nouvelle version qui fonctionne à la 1ère utilisation, sauf que au fur et à mesure que j'avance dans le traitement de mes affaires, je complète la colonne D et je relance la macro. Les dossiers présents dans "en cours" pour lesquels j'ai ajouté une valeur en colonne D doivent donc se déplacer dans "terminé" et mais j'ai un message d'erreur d'exécution 75 : erreur d'accès chemin/fichier.

Merci.

**patricktoulon** · 24/09/2018, 11h05

bonjour
sur quelle ligne ca plante la 2d fois

**pm-pr** · 24/09/2018, 11h08

33

**patricktoulon** · 24/09/2018, 12h16

re
ligne33
remplace par ca

Code :

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

1
2
ElseIf Cells(lig, "D").Value <> "" And dossier_en_cours = False And dossier_en_terminé = False Then
If Dir(CH_terminé & "\" & dossier) = "" Then MkDir (CH_terminé & "\" & dossier)

ps: je viens de me rendre compte que ca devrait pas et tu devrait pas avoir cette erreur a cause de "dossier_en_cours = False And dossier_en_terminé = False"
je pige pas la

je regarderais dans la journée si on peut pas simplifier ca

**patricktoulon** · 24/09/2018, 12h55

je reviens de verifier sur 2013 et 2007 les tests"*.*" sur dir reagissent differement
tente celui la

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
'- si la colonne D n'est pas vide et si le dossier existe déjà dans "L:\Fab\en cours" alors déplacer le dossier dans "L:\Fab\terminé"
'- si la colonne D n'est pas vide et que le dossier n'existe pas dans "L:\Fab\en cours" et qu'il existe dans "L:\Fab\terminé" alors ne rien faire
'- si la colonne D n'est pas vide et que le dossier n'existe pas dans "L:\Fab\en cours" et qu'il n'existe pas dans "L:\Fab\terminé" alors créer le dossier dans "L:\Fab\terminé"
'- si la colonne D est vide et que le dossier existe déjà dans "L:\Fab\en cours" alors ne rien faire
'- si la colonne D est vide et que le dossier n'existe pas dans "L:\Fab\en cours" alors créer le dossier dans "L:\Fab\en cours"
Public Sub Creation_repertoire2()
    With Sheets(1)
        Dim lig&, fso As Object, dossier$, rep$, zero$, dossier_en_cours As Boolean, dossier_en_terminé As Boolean, CH_encours$, CH_terminé$   ':):)
        Set fso = CreateObject("Scripting.FileSystemObject")
        CH_encours = "L:\Fab\en cours"    ' a adapter a ton cas SI C EST PAS CA
        CH_terminé = "L:\Fab\terminé"    ' a adapter a ton cas SI C EST PAS CA
 
        If Dir(CH_encours, vbDirectory) = "" Then MkDir CH_encours    ' au cas ou inexistant
        If Dir(CH_terminé, vbDirectory) = "" Then MkDir CH_terminé    ' au cas ou inexistant
 
        For lig = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            DoEvents
            dossier = Cells(lig, "A").Value & Cells(lig, "B").Value & "-" & Cells(lig, "C").Value    'concatenation du nom de dossier
            dossier_en_cours = Dir(CH_encours & "\" & dossier, vbDirectory) <> ""   'existence(true/false)
            dossier_en_terminé = Dir(CH_terminé & "\" & dossier, vbDirectory) <> ""   'existence(true/false)
 
            '   1°- si la colonne D n'est pas vide et si le dossier existe déjà dans "L:\Fab\en cours" alors déplacer le dossier dans "L:\Fab\terminé"
            If Cells(lig, "D").Text <> "" And dossier_en_cours = True Then
                fso.copyfolder CH_encours & "\" & dossier, CH_terminé & "\" & dossier
                rep = "L:\Fab\en cours\" & dossier
                fso.DeleteFolder rep
 
                '2°- si la colonne D n'est pas vide et que le dossier n'existe pas dans "L:\Fab\en cours" et qu'il existe dans "L:\Fab\terminé" alors ne rien faire
            ElseIf Cells(lig, "D").Value <> "" And dossier_en_cours = False And dossier_en_terminé = True Then
                zero = "la tete a toto"  'ben rien d'accords :)
 
                '3°- si la colonne D n'est pas vide et que le dossier n'existe pas dans "L:\Fab\en cours" et qu'il n'existe pas dans "L:\Fab\terminé" alors créer le dossier dans "L:\Fab\terminé"
            ElseIf Cells(lig, "D").Value <> "" And dossier_en_cours = False And dossier_en_terminé = False Then
            'If Dir(CH_terminé & "\" & dossier, vbDirectory) = "" Then
            MkDir (CH_terminé & "\" & dossier)
 
                '4°- si la colonne D est vide et que le dossier existe déjà dans "L:\Fab\en cours" alors ne rien faire
            ElseIf Cells(lig, "D").Value = "" And dossier_en_cours = True Then
                zero = "la tete a toto"  'ben rien d'accords :)
 
                '5°- si la colonne D est vide et que le dossier n'existe pas dans "L:\Fab\en cours" alors créer le dossier dans "L:\Fab\en cours"
            ElseIf Cells(lig, "D").Value = "" And dossier_en_cours = False Then
             'If Dir(CH_encours & "\" & dossier, vbDirectory) = "" Then
             MkDir (CH_encours & "\" & dossier)
 
            End If
        Next
    End With
 
End Sub

normalement tu peux lancer 36 mille fois la sub il n'y a pas d'erreur je viens de tester

**pm-pr** · 27/09/2018, 13h38

C'est bon tout fonctionne parfaitement. Un énorme merci, cet outil me fera gagner un temps précieux

Création et deplacement de dossiers d'archivage suivant liste excel [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager