suppresion des fichiers attaché

[nicolas]

Bonjour le forum,

J'ai un petit soucis, j'ai la macro ci dessous pour envoier le contenu d'une feuille excel par mail avec un fichier joint

Mon problème est que je connais l'exression pour ajouter une pière jointe mais pas pour supprimer les fichiers joints lorque je fais tourner ma routine

En d'autres mots, à chaque boucle de ma macro, il m'ajoute indéfiniment le même fichier joint, comment supprimé les fichiers ajouté précédemment ??



' Select the range of cells on the active worksheet.
ActiveSheet.Range('A1:I13').Select

' Show the envelope on the ActiveWorkbook.
ActiveWorkbook.EnvelopeVisible = True

With ActiveSheet.MailEnvelope
' .Introduction = 'Voila ce que donne le premier mail en excel'
.Item.To = mailing
.Item.Subject = 'test excel'

----------Le problème se situe ici ------------
.Item.Attachments.Add ('C:\\Documents and Settings\\Olivier\\Bureau\\backup.xls')
--------------------------------------------------
.Item.Send
End With
ActiveWorkbook.EnvelopeVisible = False
End Sub


Merci pour vos réponse

Nicolas

 

[Eric]

Salut Nicolas

Je n'ai pas la réponse à ton problème. Personnellement j'utilise une méthode qui fonctionne très bien avec Outlook d'Office:

Sub O_EnvoiParOutlook()
Dim ServOutlook As Object
'appel de la fonction
Set ServOutlook = CreateObject('outlook.Application')
Set Message = ServOutlook.Createitem(0)
'destinataire
Message.To = 'ev2001@gmx.ch'
'fichier attaché
Message.ATTACHMENTS.Add ActiveWorkbook.Path & '\\c.xls'
'le sujet
Message.Subject = 'Comme convenu'
'texte du message
Message.body = 'Je vous envoie ci-joint le fichier. Ceci est en réalité un essai d'envoi par Outlook'
'envoi
Message.Send
'mettre fin
Set ServOutlook = Nothing
End Sub

 

[nicolas]

merci ca marche bien

Pour le .body, j'aimerai envoie la feuille excel ou un range du genre Range('A1:I15')

Quelle est la syntaxe ?

 

[EricV]

Tu me poses une colle. Je ne vois qu'une solution, un peu compliquée, C'est de créer un classeur et de le détruire ensuite. Ainsi la feuille est envoyée en fichier attaché.

Sub O_EnvoiParOutlook()
Dim ServOutlook As Object
Dim ChDir$
Dim WkAenvoyer$

ChDir = ActiveWorkbook.Path
ActiveSheet.Copy
WkAenvoyer = ActiveSheet.Name
ActiveWorkbook.SaveAs Filename:=ChDir & '\\' & WkAenvoyer
ActiveWorkbook.Close

'appel de la fonction
Set ServOutlook = CreateObject('outlook.Application')
Set Message = ServOutlook.Createitem(0)
'destinataire
Message.to = 'ev2001@gmx.ch'
'fichier attaché
Message.ATTACHMENTS.Add ChDir & '\\c.xls'
Message.ATTACHMENTS.Add ChDir & '\\' & WkAenvoyer & '.xls'
'le sujet
Message.Subject = 'Comme convenu'
'texte du message
Message.body = 'text du message'
'envoi
Message.Send
'mettre fin
Set ServOutlook = Nothing
'
Application.DisplayAlerts = False
Kill ChDir & '\\' & WkAenvoyer & '.xls'
Application.DisplayAlerts = True
End Sub

 

[nicolas]

ben non, ca je sais bien faire mais le but était de remplir le body du mail, avec l'ancienne formule j'y arrivais sans problème, juste que je ne connais pas la syntaxe

 

[EricV]

Je crois que cette version devrait mieux répondre à ta demande.

Sub Macro2()
'Select the range of cells on the active worksheet.
ActiveSheet.Range('A1:I13').Select

' Show the envelope on the ActiveWorkbook.
ActiveWorkbook.EnvelopeVisible = True

With ActiveSheet.MailEnvelope
' .Introduction = 'Voila ce que donne le premier mail en excel'
.Item.To = mailing
.Item.Subject = 'test excel'
.Item.Attachments.Add ('Cocuments and SettingsOlivierBureaubackup.xls')
.Item.Send

For cp = 1 To .Item.Attachments.Count
.Item.Attachments(1).Delete
Next

End With
ActiveWorkbook.EnvelopeVisible = False

End Sub

 

[EricV]

La version précédente est un peu différente de celle testée: Je l'ai testé 10 fois de suite

Sub EnvoiOutlookAvecFeuilleEtClasseur()

Dim ChDir$
ChDir = ActiveWorkbook.Path
'Select the range of cells on the active worksheet.
ActiveSheet.Range('A1:I13').Select

' Show the envelope on the ActiveWorkbook.
ActiveWorkbook.EnvelopeVisible = True

With ActiveSheet.MailEnvelope
' .Introduction = 'Voila ce que donne le premier mail en excel'

cp1 = .Item.Attachments.Count
If cp1 <> 0 Then
For cp = 1 To .Item.Attachments.Count
.Item.Attachments(1).Delete
Next
End If

.Item.To = 'ev2001@gmx.fr'
.Item.Subject = 'test excel'

'----------Le problème se situe ici ------------
.Item.Attachments.Add (ChDir & '\\' & 'C.xls')
'--------------------------------------------------
On Error Resume Next
.Item.Send
On Error GoTo 0

End With
ActiveWorkbook.EnvelopeVisible = False
End Sub