Envoyer mail pièces jointes

Bonjour tout le monde!

Je me suis lancé dans les macros excel il y a quelques semaines, je ne suis donc pas encore un pro des macros, c'est pourquoi j'aurais besoin de vos aides prècieuses pour m'aiguiller.

Voici ce que je veux faire et mon problème:

Je voudrais envoyer un mail automatiquement a plusieurs distinatiares en prenants les adresses mails dans un tableau (ca, ca marche sans soucis ) le problème vient quand je veux ajouter une piècces jointes. PLus prècisement, je voudrais ajouter une seule feuille d'un classeur... J'ai le code qui permet de faire ca, mais je n'arrive pas l'adapter dans mon code qui marche deja pour l'envoie aplusieurs personnes..

Si quelqu'un à une idée de comment faire je suis preneur.

Voici mon code qui envoie à plusieurs destinataires:

Sub test()

Dim OutApp As Object

Dim OutMail As Object

Dim cell As Range, x As Integer

Dim mesdestinataires As String

Application.ScreenUpdating = False

Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup

For Each cell In Columns("E").Cells.SpecialCells(xlCellTypeConstants)

If cell.Value Like "?*@?*.?*" And _

LCase(Cells(cell.Row, "F").Value) = "oui" Then mesdestinataires = cell.Value & "; " & mesdestinataires

Next cell

x = Len(mesdestinataires) - 2

nbritem = Left(mesdestinataires, x)

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next

With OutMail

.To = mesdestinataires

.Subject = "Envoyer mail plusieurs destinataires"

.Body = "Test test test"

.Display

End With

On Error GoTo 0

Set OutMail = Nothing

cleanup:

Set OutApp = Nothing

Application.ScreenUpdating = True

End Sub

Macro pour envoyer une seul feuille:

Sub envoiMailEtFeuilleActive()

For sh = 1 To Sheets.Count

Sheets(sh).Select

ActiveSheet.Copy ' crée une copie de la feuille active

ActiveWorkbook.SendMail Recipients:=ActiveSheet.Range("a12").Value 'envoi Mail

Application.DisplayAlerts = False

ActiveWorkbook.Close ' supprime le classeur créé après l'envoi

Application.DisplayAlerts = True

Next

End Sub

Merci d'avance pour vos reponses

Bonjour,

Une petite recherche sur le forum... donnerait ceci.

A+

Merci je vais aller voir tout de suite.

Ceci permet d'envoyer un fichier entier. Mais je voudrais envoyer qu'une seule feuille du classeur. Comment faire?

Je n'ai pas mentionné cela parce que tu a déjà la technique pour faire ça en copiant la feuille dans un nouveau classeur.

C'est une feuille spécifique pour chaque destinataire ou c'est la même pour tous ?

EDIT :

Te relisant : c'est la même pour tous.

C'est la meme pièces jointe pour tout les destinataires. Mais ce que je n'arrive pas a faire c'est adapter ces quelques petites lignes de codes à mon code deja existant. :/

Essaye ceci..

Sub test()

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range, x As Integer
Dim mesdestinataires As String
Dim Chemin As String, Fichier As String
Dim Wkb As Workbook
    Application.ScreenUpdating = False

    Set Wkb = ThisWorkbook
    Chemin = Wkb.Path & "\"
    Fichier = "Test.xlsx"
    ActiveSheet.Copy ' crée une copie de la feuille active
    ActiveWorkbook.SaveAs Chemin & Fichier

    Wkb.Activate
    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In Columns("E").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" And _
    LCase(Cells(cell.Row, "F").Value) = "oui" Then mesdestinataires = cell.Value & "; " & mesdestinataires
    Next cell

    x = Len(mesdestinataires) - 2
    nbritem = Left(mesdestinataires, x)

    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = mesdestinataires
        .Subject = "Envoyer mail plusieurs destinataires"
        .Body = "Test test test"
        .Attachments.Add Chemin & Fichier
        .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
        .Send
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
    Set Wkb = Nothing
    'Eventuellement supprimer le classeur temporaire
    'Close fichier
    'Kill Chemin & fichier
End Sub

A+

Super!! C'est éxactement ce que je voulais faire! Merci beaucoup pour votre aide.

Si j'ai d'autres saucis je sais vers qui m'adresser!

J'ai de nouveau un petit soucis avec mon programme. J'aimerais fermer puis supprimer le fichier test qui est créé en copie d'un onglet pour une pièce jointe. Voici le code que je genère mais sans succé.. :/

Workbooks(test).Activate

Workbooks(test).Close

Kill " C:\Documents and Settings\s563795\Bureau\test.xlsx"

Merci pour vos reponses

Je t'ai mis le code pour supprimer le classeur (en fin de sub)

Enlève les apostrophes devant...

   Close fichier
    Kill Chemin & fichier

Merci mais j'ai une erreur qui apparait..

"Erreur d'éxécution '13'

Incompatibilité type" :/

Et le fichier ne se ferme donc pas..

J'ai été un peu vite...

    Workbooks(fichier).Close
    Kill chemin & fichier

r

C'est bon ca fonctionne parfaitement!! Merci beaucoup!

Bonjour tout le monde c'est encore moi!

Mon programme fonctionne à merveille (grace à vos aides!)

Cependant, maintenant j'aimerais que la pièce jointe soit directement dans le corps du message.. C'est à dire qu'elle soit ouverte en meme temps que le message avec les instruction dans le "body"... Mais je ne sais pas comment faire et surtout si c'est possible...

Merci d'avance

Je remet mon fichier au cas où:

Sub EnvoiFinal()

Dim OutApp As Object

Dim OutMail As Object

Dim cell As Range, x As Integer

Dim mesdestinataires As String 'Tableau dans lequel sont stoquées les adresses mails

Dim Chemin As String, Fichier As String

Dim Wkb As Workbook

Application.ScreenUpdating = False

Set Wkb = ThisWorkbook

Chemin = Wkb.Path & "\"

Fichier = "test.xlsx" 'Nom du fichier (onglet) tampon qui sert pour la pièce jointe

ActiveSheet.Copy ' crée une copie de la feuille active

ActiveWorkbook.SaveAs Chemin & Fichier

Wkb.Activate

Set OutApp = CreateObject("Outlook.Application")

'Groupement qui recupère les adresses mails

Sheets("Infos revue").Select 'Selectionne l'onglet dans lequel se trouve les adresses mails

For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants) 'Colonne C, colonne où se trouve l'adresse

If cell.Value Like "?*@?*.?*" And _

LCase(Cells(cell.Row, "D").Value) = "oui" Then mesdestinataires = cell.Value & "; " & mesdestinataires 'Colonne D, colle du critère d'envoi. Oui le mail est envoyé à ce destinataire

Next cell

x = Len(mesdestinataires) - 2

nbritem = Left(mesdestinataires, x)

Set OutMail = OutApp.CreateItem(0)

'Groupement qui envoie le mail

If MsgBox("Etes-vous certain de vouloir envoyer ce mail ?", vbYesNo, "Demande de confirmation") = vbYes Then

With OutMail

.To = mesdestinataires 'Destinataire(s) du mail. Qui va chercher dans le tableau mesdestinataires dans l'onglet infos revue

.Subject = "Compte-Rendu" 'Objet du mail

.Body = "Accès aux présentations et listes des recommandations complètes: " 'Contenu du mail

.Attachments.Add Chemin & Fichier 'Pièce jointe du mail

.Display ' Ici on peut supprimer pour l'envoyer sans vérification

.Send 'Envoi du mail

MsgBox "Le mail à bien été envoyé !"

End With

End If

'Verouillage de la feuille qui est envoyée

Sheets("Synthèse").Select

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'Vérouillage de la feuille synthèse

Set OutMail = Nothing

Set OutApp = Nothing

Set Wkb = Nothing

'Ferme et supprime le fichier test qui a servi temporairement pour la PJ

Workbooks(Fichier).Close

Kill Chemin & Fichier

End Sub

Et tu veux mettre quoi dans le "body" ?

Le contenu de l'actuelle pièce jointe

Voir ce tuto.

Merci je vais essayer avec ce tuto!