Tester si répertoire existe et le créer si non

Hello tlm,

J'ai un bouton dans un formulaire qui à pour fonction:

1. Contrôler si le dossier destination existe
2. S'il n'existe pas le créer
3. faire une copie de mon fichier et le sauver sous un chemin x
4. renommer et sauver le fichier ouvert dans le répertoire existant ou créé
5. S'il existe déjà, juste faire la copie et la sauvegarde
6. Envoi du fichier par mail

Voici mon code:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

Sub Button269_Click() 'Check dir and created if necessary, Save & Send the renamed file by email '     If (Dir("C:\Windows\Temp\repertoir_stockage")) <> "repertoir_stockage" Then MkDir ("C:\Windows\Temp\repertoir_stockage")   ActiveWorkbook.SaveCopyAs filename:="C:\Windows\Temp\" & Range("B7").Value & "_" & Range("I8").Value & "_eShell_order.xls" ActiveWorkbook.SaveAs filename:="C:\Windows\Temp\Phonak_eShell\" & Range("B7").Value & "_" & Range("I8").Value & "_eShell_order.xls" Else End If   Dim ol As Object, myItem As Object Set ol = CreateObject("outlook.application") Set myItem = ol.CreateItem(olMailItem) myItem.to = "moi@mail.com" myItem.Subject = "German acoustician order form" myItem.Body = "voici le fichier de stockage" 'fichier en cours d'utilisation envoyé en attaché: myItem.Attachments.Add ActiveWorkbook.FullName myItem.Send Set ol = Nothing   End Sub

---

Cela fonctionne très bine à la première execution mais si je l'execute à nouveau ça plante sur: MkDir ("C:\Windows\Temp\repertoir_stockage") car il existe déjà du coup.

Comme lui dire s'il existe déja juste faire:

La copie, renommage et sauvegarde

Code:

---

1 2	ActiveWorkbook.SaveCopyAs filename:="C:\Windows\Temp\" & Range("B7").Value & "_" & Range("I8").Value & "_eShell_order.xls" ActiveWorkbook.SaveAs filename:="C:\Windows\Temp\Phonak_eShell\" & Range("B7").Value & "_" & Range("I8").Value & "_eShell_order.xls"

---

Et l'envoi par mail en attachment:

Code:

---

1 2 3 4 5 6 7 8 9 10

Dim ol As Object, myItem As Object Set ol = CreateObject("outlook.application") Set myItem = ol.CreateItem(olMailItem) myItem.to = "moi@mail.com" myItem.Subject = "German acoustician order form" myItem.Body = "voici le fichier de stockage" 'fichier en cours d'utilisation envoyé en attaché: myItem.Attachments.Add ActiveWorkbook.FullName myItem.Send Set ol = Nothing

---

Merci d'avanc epour votre aide!:king:

Code:

---

1 2 3

If Dir("U:\Toto", vbDirectory) <> "" Then 'Ton fichier U:\Toto existe donc pas la peine de le créer

---

Bonjour,

ceci te créera le répertoire c:\toto\titi\tata\, y compris ses sous-répertoires, que s'il le faut (que ce qu'il faut) , sans la moindre faille :

Code:

---

1 2 3 4 5

Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long   Private Sub Command1_Click() SHCreateDirectoryEx 0, "c:\toto\titi\tata\", ByVal 0& End Sub

---

Interessant comme solution.. je ne connaissais pas

Pas sur que cette fonction soit forcément présente sur toutes les installations ==> attention à ce genre de truc....

bonjour a tous,

j'apporte encore une autre solution, juste pour la forme:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

Sub tt() 'Il ne faut pas oublier de rajouter la réference 'Miscrosoft Scripting runtime   Dim fso As FileSystemObject Dim fsoMonDossier As Folder Dim stMonChemin As String   stMonChemin = "c:\temp\monchemin"   Set fso = New FileSystemObject   If Not fso.FolderExists(stMonChemin) Then Set fsoMonDossier = fso.CreateFolder(stMonChemin) End If   End Sub

---

Citation:

---

Envoyé par EvaristeGaloisBis

bonjour a tous,

j'apporte encore une autre solution, juste pour la forme:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

Sub tt() 'Il ne faut pas oublier de rajouter la réference 'Miscrosoft Scripting runtime   Dim fso As FileSystemObject Dim fsoMonDossier As Folder Dim stMonChemin As String   stMonChemin = "c:\temp\monchemin"   Set fso = New FileSystemObject   If Not fso.FolderExists(stMonChemin) Then Set fsoMonDossier = fso.CreateFolder(stMonChemin) End If   End Sub

---

---

ce code na marche pas pour moi

Bonjour,
D'abord vous déterrez une vieille discussion (près de 14 ans)

Citation:

---

ce code na marche pas pour moi

---

Indiquer que "cela ne marche pas" ne veux strictement rien dire.
Qu'est-ce qui ne fonctionne pas ?
Le répertoire ne se crée pas ou bien vous avez un message d'erreur et dans l'affirmative quel est le numéro et surtout quel message s'affiche

Sinon, je peux vous affirmer que la procédure telle qu'elle est publiée fonctionne parfaitement. A condition bien entendu d'avoir référencé le complément indiqué en commentaire.