Creation de repaertoire

[Pierre]

Bonjour à tous les membres du Forum

Voici mon probleme qui va avec le petit fichier joins.

Dans une case que je nome Ch_Fichier, j'y inscrit le chemin où je voudrais enregistrer automatiquement mon fichier. Le probleme que je rencontre et que je ne sais realiser c'est la creation des repertoire ds mes documents alors que ceux ci n'existe pas. Dans mon exemple je voudrais cree automatiquement le repertoire Billard et Equipes.

Pourriez vous me donner une petit coups de main pour solutionner ce probleme.

Merci par avance


PS: Le 1er partie de ma macro m'ouvre la fenetre d'enregistrement mais je voudrais une macro qui le fasse automatiquement sans avoir a passer par celle-ci
Merci

 

[@+Thierry]

Bonjour Pierre, le Forum

Je ne peux pas actuellement télécharger de fichier pour raison de sécurité, mais je pense cerner ta question sans voir ton exemple.

Voici une étude/test que je me suis faite et que je garde comme exemple :

Const TheMainPath As String = "C:\Program Files\My Program\"
Const TheArchivePath As String = "C:\Program Files\My Program\My Archive\"


Sub TestMkDirMultiLevel1()
On Error GoTo NextStep
MkDir TheMainPath
NextStep:
TestMkDirMultiLevel2
End Sub

Sub TestMkDirMultiLevel2()
On Error GoTo Sortie
MkDir TheArchivePath
Exit Sub

Sortie:
If Err = 75 Then
MsgBox "Le Chemin " & TheArchivePath & " existe déjà"
Else
MsgBox "Une Erreur non gérée s'est Produite : " & Err.Number & " " & Err.Description
End If
End Sub

Cette double procédure est en fait assez simple, si le répertoire "My Program" n'existe pas en tant que sous répertoire dans "Program Files" alors il sera créé par la Sub "TestMkDirMultiLevel1"... Si par contre il existe déjà, celà génère une erreur que je gère avec l'étiquette "NextStep:" (On Error GoTo NextStep) qui, donc permet de passer à l'étape suivante en lançant la macro "TestMkDirMultiLevel2".

Dans cette dernière c'est le même processus, si le sous répertoire "My Archive" n'existe pas dans "My Program" alors il sera créé, sinon je lance un message de confirmation que le répertoire existe déjà.

Dans ton cas, il suffit de sauter cette étape de message et d'adapter à la place l'enregistrement automatique de ton fichier.

Pour finir, je procède aà la défintion des "Path" par deux Constantes (TheMainPath & TheArchivePath) mais tu pourrais définir la même chose avec des Variables pointant sur tes cellules comme ceci : (NB toujours respecter la construction d'un répertoire à la fois, le sous répertoire ne pouvant être créé qu'après création du répertoire "parent")

Dim TheMainPath As String
Dim TheArchivePath As String

Sub TestMkDirMultiLevel1()
TheMainPath = Range("Ch_Fichier")
TheArchivePath = Range("Ch_Fichier_Sub-Dir")
On Error GoTo NextStep
MkDir TheMainPath
NextStep:
TestMkDirMultiLevel2
End Sub

La suite ne changeant pas. Attention par contre il n'y a aucun test de vérification sur les valeurs contenues dans les cellules...

Bonne Journée
@+Thierry

 

[Pierre]

Bonjour Thierry

Merci pour ta reponse si rapide. Je vais essayer cela de suite et je te tiens au courant.

Bonne journée.

 

[Pierre]

Thierry

C'est super ce que tu m'as donné car ca marche. Mon autre probleme c'est que dans la case Chemin l'utilisateur va rentré le chemin complet du fichier. Comment puis je savoir si 2 repertoire son a créer. Y a t il un moyen pour pouvoir serparer sa saisie pour pouvoir d'abord creer le repertoire source puis le sous repertoire? (exemple l'utilisateur saisie le chemin suivant qui n'existe pas sur sa machine "c:\Billard\Equipes\")
Merci de ton aide

 

[@+Thierry]

Re Bonjour Pierre,

Oui je savais que ce que je t'ai donné marche, ça court même, je m'en sers très souvent !

Ok j'ai pigé ton problème, alors là c'est encore plus simple, si tu as au moins Excel 2000, (sinon pour Excel 97, il faut passer par une combinaison de Instr et de Mid car il ne connait pas la Function Split)

Sub CheckingMakingDir()
Dim TheFullPath As String
Dim TheSplitedPath As Variant
Dim i As Byte, NbRep As Byte
Dim ThePath As String

TheFullPath = Range("Ch_Fichier")
TheSplitedPath = Split(TheFullPath, "\")

NbRep = UBound(TheSplitedPath)
For i = 0 To NbRep
ThePath = ThePath & TheSplitedPath(i) & "\"
MakingDir ThePath
Next
End Sub

Sub MakingDir(ThePath As String)
On Error GoTo TheEnd
MkDir ThePath
TheEnd:
End Sub

Bon Appétit
@+Thierry

 

[Pierre]

Salut Thierry

Vraiment je te remercie pour cette macro, Tu m'a retiré une sacrée epine du pied. Merci encore pour ton aide.