Discussion :

[yoda73]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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!

[helios77]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[ucfoutu]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[helios77]

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....

[EvaristeGaloisBis]

bonjour a tous,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[legone38]

bonjour a tous,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Philippe Tulliez]

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

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.