VBA creation de repertoir
regroupjf
Messages postés
7
Date d'inscription
lundi 5 novembre 2007
Statut
Membre
Dernière intervention
13 novembre 2007
-
6 nov. 2007 à 11:18
regroupjf Messages postés 7 Date d'inscription lundi 5 novembre 2007 Statut Membre Dernière intervention 13 novembre 2007 - 6 nov. 2007 à 15:47
regroupjf Messages postés 7 Date d'inscription lundi 5 novembre 2007 Statut Membre Dernière intervention 13 novembre 2007 - 6 nov. 2007 à 15:47
4 réponses
TheSaib
Messages postés
2367
Date d'inscription
mardi 17 avril 2001
Statut
Membre
Dernière intervention
26 décembre 2007
23
6 nov. 2007 à 12:25
6 nov. 2007 à 12:25
Mkdir 'tonrepertoire'
::|The S@ib|::
MVP C#.NET
::|The S@ib|::
MVP C#.NET
regroupjf
Messages postés
7
Date d'inscription
lundi 5 novembre 2007
Statut
Membre
Dernière intervention
13 novembre 2007
6 nov. 2007 à 14:02
6 nov. 2007 à 14:02
oui j ai vu que mkdir creer le repertoir mais pour faire des test sur l'existance du repertoir et la gestions des erreurs
et d'autre part pour le repertoir c'est a l'utilisateur de faire rentrer son nom a chaque fois que le programme est execute
et d'autre part pour le repertoir c'est a l'utilisateur de faire rentrer son nom a chaque fois que le programme est execute
pneau
Messages postés
258
Date d'inscription
mercredi 21 avril 2004
Statut
Membre
Dernière intervention
27 octobre 2010
5
6 nov. 2007 à 15:36
6 nov. 2007 à 15:36
salut,
pour tester l'existence du répertoire, gérer les erreurs et créer le rep, tu peux utiliser la procédure ci desous :
SMonrep est le chemin complet du dossier
private sub CreateFolder (sMonRep as string)
on error goto errCreate
If Dir(sMonRep,Vbdirectory) = "" then
'Rep inexistant
mkdir sMonrep
endif
exit sub
errCreate:
msgbox "Erreur pendant la creation du répertoire " & sMonRep & vbcrlf & _
err.number & " - " & err.description, vbcritical, "ERREUR"
end sub
le souci de cette procédure est que si ton chemin est composé de plusieurs sous dossiers, si l'un d'entre eux n'existe pas, tu auras un plantage.
dans ce cas, tu peux utiliser une autre routine qui s'appuie sur du VBScript. Je l'utilise en VB mais a toi de la tester en VBA. (je ne pense pas qu'il y ait de probleme)
Public Function CreateFolder(sRepertoire As String, Optional sSousRepSup As String = "") As Boolean
'Fonction permettant de lancer la création d'un répertoire sur le disque
'L'argument "sSousRepSup" permet de chainer avec la création d'un sous répertoire supplémentaire pour le
'sRepertoire passé en paramètre
On Error GoTo errCreateFolder
Dim fs
Dim Arborescence() As String
Dim i As Integer
If Right(sRepertoire, 1) <> "" Then sRepertoire = sRepertoire & ""
Set fs = CreateObject("Scripting.FileSystemObject")
'Découpage du chemin en fonction des ""
Arborescence = Split(sRepertoire, "")
For i = 1 To UBound(Arborescence) - 1
'Boucle sur l'ensemble des niveaux de l'arborescence pour vérifier et créer chaque niveau
Arborescence(i) = Arborescence(i - 1) & "" & Arborescence(i)
If Not fs.FolderExists(Arborescence(i)) Then fs.CreateFolder (Arborescence(i))
Next i
If sSousRepSup <> "" Then
'Création du sous répertoire supplémentaire
If Not fs.FolderExists(sRepertoire & "" & sSousRepSup) Then
fs.CreateFolder (sRepertoire & "" & sSousRepSup)
End If
End If
Set fs = Nothing
CreateFolder = True
Exit Function
errCreateFolder:
msgbox "Erreur pendant la creation du répertoire " & sMonRep & vbcrlf & _
err.number & " - " & err.description, vbcritical, "ERREUR"
CreateFolder = False
End Function
voilà, en espérant t'avoir aidé un peu
cordialement
Pat
pour tester l'existence du répertoire, gérer les erreurs et créer le rep, tu peux utiliser la procédure ci desous :
SMonrep est le chemin complet du dossier
private sub CreateFolder (sMonRep as string)
on error goto errCreate
If Dir(sMonRep,Vbdirectory) = "" then
'Rep inexistant
mkdir sMonrep
endif
exit sub
errCreate:
msgbox "Erreur pendant la creation du répertoire " & sMonRep & vbcrlf & _
err.number & " - " & err.description, vbcritical, "ERREUR"
end sub
le souci de cette procédure est que si ton chemin est composé de plusieurs sous dossiers, si l'un d'entre eux n'existe pas, tu auras un plantage.
dans ce cas, tu peux utiliser une autre routine qui s'appuie sur du VBScript. Je l'utilise en VB mais a toi de la tester en VBA. (je ne pense pas qu'il y ait de probleme)
Public Function CreateFolder(sRepertoire As String, Optional sSousRepSup As String = "") As Boolean
'Fonction permettant de lancer la création d'un répertoire sur le disque
'L'argument "sSousRepSup" permet de chainer avec la création d'un sous répertoire supplémentaire pour le
'sRepertoire passé en paramètre
On Error GoTo errCreateFolder
Dim fs
Dim Arborescence() As String
Dim i As Integer
If Right(sRepertoire, 1) <> "" Then sRepertoire = sRepertoire & ""
Set fs = CreateObject("Scripting.FileSystemObject")
'Découpage du chemin en fonction des ""
Arborescence = Split(sRepertoire, "")
For i = 1 To UBound(Arborescence) - 1
'Boucle sur l'ensemble des niveaux de l'arborescence pour vérifier et créer chaque niveau
Arborescence(i) = Arborescence(i - 1) & "" & Arborescence(i)
If Not fs.FolderExists(Arborescence(i)) Then fs.CreateFolder (Arborescence(i))
Next i
If sSousRepSup <> "" Then
'Création du sous répertoire supplémentaire
If Not fs.FolderExists(sRepertoire & "" & sSousRepSup) Then
fs.CreateFolder (sRepertoire & "" & sSousRepSup)
End If
End If
Set fs = Nothing
CreateFolder = True
Exit Function
errCreateFolder:
msgbox "Erreur pendant la creation du répertoire " & sMonRep & vbcrlf & _
err.number & " - " & err.description, vbcritical, "ERREUR"
CreateFolder = False
End Function
voilà, en espérant t'avoir aidé un peu
cordialement
Pat
regroupjf
Messages postés
7
Date d'inscription
lundi 5 novembre 2007
Statut
Membre
Dernière intervention
13 novembre 2007
6 nov. 2007 à 15:47
6 nov. 2007 à 15:47
merci infiniment pour ton aide la je viens de reussir a faire marcher un bout de code pour la creation du repertoire 'Contrôler si répertoire existe?
Dim MyPath As String 'Définition des variables
Dim MyName As String
Dim RepertName As String
'
RepertName$ = Text3.Text
MyPath = "chemien" & RepertName$ 'On initialise la variable
If Text3.Text = "" Then
Title$ = "Création d'un répertoire"
msg = "Veuillez saisir le nom du répertoire à créer!"
MsgBox msg, 64, Title$
Text3.SetFocus
Else
'Instructions
End If
'Si l' utilisateur n' a pas saisie un nom... alors sortie du programme
If Text3.Text = "" Then Exit Sub
'Puisqu'il a saisi un nom, nous traitons sa demande!If (MyName Dir(MyPath, vbDirectory)) vbEmpty Then
'On teste l' existence du répertoire
MsgBox "Le répertoire " & Chr(34) & MyPath & Chr(34) & " existe bien!"
ActiveWorkbook.SaveAs "chemien" & RepertName$ & "\FI_R2007_" & UserForm1.TextBox1.Value & "_" & UserForm1.TextBox2.Value & ".xls"
UserForm1.Hide
'Si le répertoire saisie existe... alors sortons....
Exit Sub
Else
MsgBox "Le répertoire " & Chr(34) & MyPath & Chr(34) & " n 'existe pas!", vbExclamation
'Alors...créons le répertoire
RepertName$ = Text3.Text
MkDir "E:\gesbudg\2007BUDGET\DOMO\Facturation Interne\faten" & RepertName$ 'Indiquez le chemin ou doit être stocké le répertoire
End If
'Ouverture d' une fenêtre de dialogue
MsgBox "Le répertoire " & RepertName$ & " vient d' être créé!"
Dim MyPath As String 'Définition des variables
Dim MyName As String
Dim RepertName As String
'
RepertName$ = Text3.Text
MyPath = "chemien" & RepertName$ 'On initialise la variable
If Text3.Text = "" Then
Title$ = "Création d'un répertoire"
msg = "Veuillez saisir le nom du répertoire à créer!"
MsgBox msg, 64, Title$
Text3.SetFocus
Else
'Instructions
End If
'Si l' utilisateur n' a pas saisie un nom... alors sortie du programme
If Text3.Text = "" Then Exit Sub
'Puisqu'il a saisi un nom, nous traitons sa demande!If (MyName Dir(MyPath, vbDirectory)) vbEmpty Then
'On teste l' existence du répertoire
MsgBox "Le répertoire " & Chr(34) & MyPath & Chr(34) & " existe bien!"
ActiveWorkbook.SaveAs "chemien" & RepertName$ & "\FI_R2007_" & UserForm1.TextBox1.Value & "_" & UserForm1.TextBox2.Value & ".xls"
UserForm1.Hide
'Si le répertoire saisie existe... alors sortons....
Exit Sub
Else
MsgBox "Le répertoire " & Chr(34) & MyPath & Chr(34) & " n 'existe pas!", vbExclamation
'Alors...créons le répertoire
RepertName$ = Text3.Text
MkDir "E:\gesbudg\2007BUDGET\DOMO\Facturation Interne\faten" & RepertName$ 'Indiquez le chemin ou doit être stocké le répertoire
End If
'Ouverture d' une fenêtre de dialogue
MsgBox "Le répertoire " & RepertName$ & " vient d' être créé!"
