Attacher une pièce jointe systématiquement
bonjour,
je dispose d'un code sur un classeur EXCEL qui me permet d'envoyer un mail via outlook.
Le code marche bien.
J'ai dupliquer ce code pour l'adapter en cas de modification.
Si je lance le code après modification tout fonctionne mais si je retente de modifier il m'envoie le mail mais sans la pièce jointe.
je suis obliqger de fermer le fichier pour refaire ma modif.
En bref si j'execute mon code plusieurs fois d'affilé la pièce jointe n'est plus jointe.
N y a t il pas moyen de faire que la pièce jointe soit présente à chaque coup?
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
25
26
27
28
29
30
31
32
33
34
35
36
37
| Sub mailcorrige()
Dim bstarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bstarted = True
End If
Set oItem = oOutlookApp.CreateItem(olMailItem)
liste = "toto@test.fr"
With oItem
.To = liste
.Subject = "Rapport Corrigé quotidien du " & Format(ActiveSheet.Range("d1"), "DD-MM-YY")
.Body = "Bonjour" & Chr(13) & Chr(13) & "Veuillez trouver ci joint le rapport quotidien version corrigée pour la journée du " & Format(ActiveSheet.Range("d1"), "DD-MM-YY") & Chr(13) & Chr(13) & "Cordialement"
.Attachments.Add Source:=ActiveDocument.FullName, Type:=olByValue, DisplayName:="Rapport en pièce jointe"
.Send
End With
If bstarted Then
oOutlookApp.Quit
End If
Set oItem = Nothing
Set oOutlookApp = Nothing
End Sub |
a savoir que le activedocument est un fichier Word ouvert au moment de l'exécution du code.
Si quelqu'un peux m'aider.
je vous remercie d'avance.
