Récupérer n valeur d'une colone et créer n répertoire

Bonsoir Franck,
En supposant les noms commencer en A1 :

Sub repenplus()
'MPFE 21/01/2004
Dim z As Long
z = Application.WorksheetFunction.CountA(Range("a:a"))
For i = 1 To z
MkDir ("c:/" & Cells(i, 1).Value)
Next i
End Sub

--
Amicales Salutations
A_S_rauphil@wanadoo.fr
Retirer A_S_ pour répondre.
XL97 / XL2002
Pour suivre le forum :
news://msnews.microsoft.com/microsoft.public.fr.excel
(Voulez-vous vous abonner ? -> Oui)

"Franck" <anonymous@discussions.microsoft.com> a écrit dans le message de
news:1bfc01c3e023$5a30a340$a601280a@phx.gbl...
Bonjour,


Est-il possible de créer des répertoires automatiquement
depuis excel,
- qui auront comme nom, la valeur des cellules de la
colonne A1 par exemple

Si oui, pouvez-vous me donner un exemple SVP

Merci pour votre aide
Franck

Bonsoir,

En supposant une liste de chemin/répertoires à créer en A1:A10 d'une feuille
nommée Feuil1, tu peux utiliser la fonction ci-dessous (le code est à recopier
dans un module standard du classeur où tu veux l'utiliser). Note : un ou tous
les répertoires du chemin des répertoires à créer peuvent ne pas exister.

'============= Sub test()
Dim i&
For i = 1 To 10
CreeChemin Range("A" & i).Value
Next i
End Sub

Function CreeChemin(S$)
'créer un répertoire et ses répertoires parents s'ils n'existent pas
'adaptation pour Excel 97 d'une fonction de Dana DeLouis
'(contribution de Dave Peterson) (mpep, avril 2002)
'Valeurs retournées :
' -1 : succès
' 1 : erreur (caractère invalide dans le chemin)
' 2 : erreur (le lecteur n'existe pas)
' 3 : erreur (lecteur amovible non prêt)
' 4 : erreur (le lecteur est un lecteur de cdrom)
' 5 : erreur (le dossier est en fait un fichier sans extension...)

Dim j%, FSO As Object, Drv$, tmpDir$, sDir$
Dim pos1%, pos2%, Arr, NbRep%

'// Vérifie la validité des noms des répertoires à créer
S = Trim(S)
j = 0
j = j + InStr(1, S, "/")
j = j + InStr(3, S, ":") ' the ":" in C:
j = j + InStr(1, S, "*")
j = j + InStr(1, S, "?")
j = j + InStr(1, S, ">")
j = j + InStr(1, S, "<")
j = j + InStr(1, S, "|")
j = j + InStr(1, S, """")

If j > 0 Then
CreeChemin = 1 'caractère invalide dans le chemin
Exit Function
End If

'Vérifie la validité du lecteur racine du chemin
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO
Drv = .GetDriveName(S) & Application.PathSeparator ' ie C:

'// Valid Drive? (as in A:, C:, D: ...etc)
If Not .DriveExists(Drv) Then
CreeChemin = 2 'le lecteur n'existe pas
Exit Function
End If

'// Is Drive Ready (as in no Floppy in A:)?
If Not .getdrive(Drv).IsReady Then
CreeChemin = 3 'lecteur amovible non prêt
Exit Function
End If

'// Unable if CD-Rom
If .getdrive(Drv).DriveType = 4 Then
CreeChemin = 4 'le lecteur est un lecteur de cdrom
Exit Function
End If

'construire un tableau avec les noms des différents
'répertoires du chemin, sans utiliser Split (Excel 2000 et +)
If Right(S, 1) = "" Then S = Left(S, Len(S) - 1)
NbRep = Len(S) - Len(Application.Substitute(S, "", ""))
ReDim Arr(NbRep - 1)
pos1 = 3
Do
pos2 = InStr(pos1 + 1, S, "")
If pos2 = 0 Then
tmp = Mid(S, pos1 + 1)
Else: tmp = Mid(S, pos1 + 1, pos2 - pos1 - 1)
End If
pos1 = pos2: i = i + 1
Arr(i - 1) = tmp
Loop While i < NbRep

'// First test each branch for a File with no Extension!
sDir = Drv
For j = 0 To UBound(Arr)
sDir = .BuildPath(RTrim$(sDir), Arr(j))
If .FileExists(sDir) Then
CreeChemin = 5 'le dossier est en fait un fichier sans extension...
Exit Function
ElseIf Not .FolderExists(sDir) Then
Exit For ' Does not exist..No need to continue
End If
Next j

' Everything looks Ok, so make Directories
sDir = Drv
For j = 0 To UBound(Arr)
sDir = .BuildPath(RTrim$(sDir), Arr(j))
If Not .FolderExists(sDir) Then .CreateFolder sDir
Next j

End With
Set FSO = Nothing
CreeChemin = -1

End Function
'=============
FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

Bonjour,

Est-il possible de créer des répertoires automatiquement
depuis excel,
- qui auront comme nom, la valeur des cellules de la
colonne A1 par exemple

Si oui, pouvez-vous me donner un exemple SVP

Merci pour votre aide
Franck