Problème programme création répertoire en VBA

Bonjour,

Je démarre en VBA et, je coince sur une erreur dans un programme developpé

l'année dernière par un stagiaire.

le fichier principal "dérogation" est une BDD simple. Le programme permet de créer un repertoire

à l'endroit ou se localise le fichier "dérogation". Le non du répertoire se trouve dans la derniere celulle

non vide de la première colonne. S'il n'existe pas, il est crée.

Sub Creer_dossier()

Sheets("Derogations").Unprotect

Dim fso

'On cache la procédure

Application.ScreenUpdating = False

'On appele l'object FileSystemObject

'Pour accéder aux fichiers, aux répertoires et aux volumes gérés par Windows,

'il faut d'abord instancier l'objet Scripting.FileSystemObject comme ceci :

Set fso = CreateObject("Scripting.FileSystemObject")

'On enregistre dans une variable l'adresse où le fichier d'Excel est enregistré

adresse = ActiveWorkbook.Path

'On sélectionne la première cellule où il y a les noms des fichiers a créer

Range("A3").Select

'On cherche dans toute la colonne jusqu'à trouver une ligne

'vide et pour chaque ligne avec texte on crée un fichier

Do While Not IsEmpty(ActiveCell)

'Si le ficher n'existe pas, on le crée

If Not fso.FolderExists(adresse & "\" & ActiveCell.Value) Then

fso.CreateFolder (adresse & "\" & ActiveCell.Value) <----- blocage sur cette ligne

'On va à la ligne suivante et on refait le boucle

ActiveCell.Offset(1, 0).Select

Loop

'On efface la valuer de fso pour recommencer

Set fso = Nothing

Application.ScreenUpdating = True

Sheets("Derogations").Protect

End Sub

Au lancement le programme coince sur la ligne :

fso.CreateFolder (adresse & "\" & ActiveCell.Value)

Je ne comprends pas d'ou vient le problème.

Merci pour votre aide

Bonjour,

Je n'ai pas de soucis sur ton code.

Par contre j'aurais plutot fait ceci comme code :

Sub Creer_dossier()
Sheets("Derogations").Unprotect
Dim lig As Byte
Dim fso, cel
Application.ScreenUpdating = False

Set fso = CreateObject("Scripting.FileSystemObject")
lig = 3
cel = Range("A" & lig).Value
Do While Not IsEmpty(Range("A" & lig))
    If Not fso.FolderExists(ThisWorkbook.Path & "\" & cel) Then
        fso.CreateFolder (ThisWorkbook.Path & "\" & cel)
    End If
    lig = lig + 1
Loop
Set fso = Nothing
Application.ScreenUpdating = True
Sheets("Derogations").Protect
End Sub

Si ok, clique sur le V vert à coté du bouton EDITER pour cloturer le fil lors de ta réponse

Crdlt

Bonjour,

Merci pour ce code qui me paraît en effet plus clair que le précédent.

Par contre, je ne comprends pas car malgré la boucle le répertoire

n'est crée que uniquement par rapport à la celulle A3. Le but étant

de balayer la colonne A (à partir de A3) est de détecter la dernière

celulle non vide. Ensuite on reprend la valeur de la celulle que l'on stocke, si

le répertoire n'existe pas, on le crée sinon RAS.

Merci encore pour votre aide

Je mets le fichier test en P.J

27classeur2.xlsm (15.87 Ko)

Re,

Oups....

L'instruction "cel = Range("A" & lig).Value" doit être placée dans la boucle DO et pas avant

Déplace la pour avoir ceci :

....
Do While Not IsEmpty(Range("A" & lig))
cel = Range("A" & lig).Value
....

Si ok, n'oublie pas de cliquer sur le V vert à coté du bouton EDITER pour la cloture du fil

Cordialement

Rechercher des sujets similaires à "probleme programme creation repertoire vba"