envoyer mail ( avec outlook) depuis excel avec piece jointe feuille active

[wrap food]

Bonjour

Après de multiples recherche, je n'arrive pas a trouver un code qui me permet d'envoyer la feuille active en pièce jointe.

J'ai un fichier de base depuis lequel l'opérateur crée un feuille et l'enregistre dans le même dossier que celui de base (ci-dessous le code que j'utilise)

ActiveSheet.Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Format(Range("D14"), "yy-mm-dd") & " " & Range("g8") & " " & Format(Range("T14"), "0h00") & " " & Range("U1") & " " & Range("U2") & " " & Range("U3") & " " & Range("U4") & " " & Range("U5") & " " & Range("U6") & " " & Range("E15") & " " & Range("M14") _
& ".xls"

Mon problème est que souhaiterais créer un code pour envoyer ce fichier en pièce jointe.
et si c'est possible d'utiliser les valeurs contenues dans des cellules pour


Cellule A5 pour l'adresse du destinataire
Cellule A6 pour l'adresse de la copie
Cellule A7 pour l'objet
Cellule A8 le texte du mail


je suis désolé, j'en demande beaucoup, mais la je suis perdu

par avance merci de votre aide

 

[xhudi69]

Re : envoyer mail ( avec outlook) depuis excel avec piece jointe feuille active

Bonjour wrap food, le Forum,

Bonne année 2015

Cherche ICI et tu trouveras.

@+

 

[wrap food]

Re : envoyer mail ( avec outlook) depuis excel avec piece jointe feuille active

Re-bonjour

J'ai réussi a créer la macro pour envoyer le mail avec une pièce jointe .

code pour envoie de mail.
Private Sub Envoie_Mail_1()
Dim MonOutlook As Object
Dim MonMessage As Object
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)
MonMessage.to = Range("B5")
MonMessage.Cc = Range("B6")
MonMessage.Subject = Range("B63")
MonMessage.body = Range("G63")
MonMessage.Attachments.Add ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
MonMessage.send
End Sub


mon problème c'est que je n'arrive pas a envoyer le mail crée par ma premier macro .

ActiveSheet.Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Format(Range("D14"), "yy-mm-dd") & " " & Range("g8") & " " & Format(Range("T14"), "0h00") & " " & Range("U1") & " " & Range("U2") & " " & Range("U3") & " " & Range("U4") & " " & Range("U5") & " " & Range("U6") & " " & Range("E15") & " " & Range("M14") _
& ".xls"

auriez-vous la solution pour intégrer le code N°2 au premier

Par avance Merci

 

[camarchepas]

Re : envoyer mail ( avec outlook) depuis excel avec piece jointe feuille active

Bonjour,

a analyser et adapter,

une routine de préparation et 2 fonctions dédiées.

Couvre une bonne partie des utilisations

Sub Gestion_Mail()
'Préparation de l'envoi de Mail
'Ici l'on régle tout
 Dim Sujet As String, Message As String, Fichier As String, Destinataire As String
 Dim Copie As String, CopieCachée As String, Chemin As String
 Dim Condition As Boolean, Apercu As Boolean, Alerte As Boolean
 
 '******** ** * Tous ceci est à adapter * ** ************
 
 Sujet = "Envoi Facture " & Sheets("Facture").Range("C7").Text 'titre du mail
 Message = "Voici la Facture " & Sheets("Facture").Range("C7").Text & " du " & Date ' Message dans le mail
 Chemin = "c:\temp\" 'Répertoire de travail
 Fichier = Chemin & "pj_du_" & Replace(Date, "/", "-") & ".xlsx" 'Emplacement et nom du fichier de Sauvegarde provisoire
 Destinataire = Sheets("Réglages").Range("L7") 'adresse mail Destinataire principal
 Copie = "" 'Destinataire en copie
 CopieCachée = "" 'Destinataire en copie cachée
 Apercu = False 'True ' Autorise la prévisualisation
 'Ici somme les conditions minimum pour envoi du courrier, sinon laisser à vrai
 'ex :  Condition = IIf(Message <> "", True, False)
 Condition = True
 Alerte = True 'Permet d'obtenir un popup si anomalie pas de destinataire avant la sortie sans envoi
 
 'Fin des réglages ************************
 
 'Prépare la sauvegarde de la pièce jointe
  Sheets("pj").Select 'Saisir le nom exact la feuille
  ActiveSheet.Copy
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs Fichier  'Sauvegarde Feuille
  Application.DisplayAlerts = True
  ActiveWorkbook.Close False
 'Transfert vers la routine Courrier
 If Condition Then Courrier Sujet, Message, Fichier, Destinataire, Apercu, Alerte, Copie, CopieCachée
 ThisWorkbook.Save
 'Supprime le fichier temporaire
 Kill Fichier
End Sub

Sub Courrier(Sujet As String, Message As String, Fichier As String, Destinataire As String, _
      Apercu As Boolean, Alerte As Boolean, Optional Copie As String, Optional CopieCachée As String)
'Envoi de mail via Outlook
'*********************** ICI ne rien toucher *********************************

 Dim Appli_Outlook As Object, Mail_Outlook As Object
 Dim NS As Object 'Namespace
 Dim Envoi As Variant
 Dim Temps_Max As Double
'Ne doit jamais planter
 On Error GoTo Sortie
'Initialise
 Set Appli_Outlook = CreateObject("Outlook.Application")
 Set Mail_Outlook = Appli_Outlook.CreateItem(0)
 With Mail_Outlook
   If InStr(Destinataire, "@") > 0 Then
       .To = Destinataire
     Else
       If Alerte Then MsgBox "Pas de destinataire"
       GoTo Sortie
   End If
   If InStr(Copie, "@") > 0 Then .CC = Copie
   If InStr(CopieCachée, "@") > 0 Then .BCC = CopieCachée
   
   .Subject = Sujet
   .BodyFormat = 1 'olFormatPlain
   .Body = Message

  '.Importance = 2 'olImportanceHigh
  '.Sensitivity = 3 'olConfidential
   If Fichier <> "" And Dir(Fichier) <> "" Then .Attachments.Add Fichier
   If Apercu Then .Display 'Si demandé , propose l'aperçu du Mail
   If Not Apercu Then .Send  'envoye du mail
   '
 End With
'Attente envoi message
Temps_Max = Timer + 0.5 * 60
Set NS = Appli_Outlook.GetNamespace("MAPI")
Do
 Set Envoi = NS.GetDefaultFolder(4) ' olFolderOutbox = 4 (Boite d'envoi)
Loop Until Envoi.Items.Count = 0 Or Timer > Temps_Max
Sortie:
'Réactive la gestion d'erreur par Excel
On Error GoTo 0
Set Mail_Outlook = Nothing
Set Appli_Outlook = Nothing

End Sub

Sub ListeBoiteDEnvoi()
 Dim Appli_Outlook As Object, Mail_Outlook As Object
'Initialise
 Set Appli_Outlook = CreateObject("Outlook.Application")
Dim NS As Object 'Namespace
Dim Envoi
Set NS = Appli_Outlook.GetNamespace("MAPI")
Set Envoi = _
NS.GetDefaultFolder(4) '(olFolderOutbox) '4
MsgBox "Nombre de messages : " & Envoi.Items.Count
End Sub

 

[wrap food]

Re : envoyer mail ( avec outlook) depuis excel avec piece jointe feuille active

bonjour

Etant débutant, j'ai un peux de mal à comprendre le code .

est-il possible de simplifier un peut su la base de mes deux exemples

encore désolé, mais je ne veux pas utiliser un code que je comprendrais pas ou à moitié.

par avance merci

 

[wrap food]

Re : envoyer mail ( avec outlook) depuis excel avec piece jointe feuille active

Re-bonjour

En faite je n'arrivé pas à mettre les deux codes a l'affilé.
C'est pour cela que l'aurais besoins d'aide ci cela est possible bien sur.

Merci beaucoup

 

[Yaloo]

Re : envoyer mail ( avec outlook) depuis excel avec piece jointe feuille active

Bonsoir wrap food, xhudi69, camarchepas,

N'ayant pas de fichier de ta part, xhudi69 et camarchepas te donnent des exemples ou des liens pour t'aider à trouver une solution.
Le plus simple pour t'aider serait que tu nous mette ton fichier sans données personnelles.

A te relire

Martial

 

[Yaloo]

Re : envoyer mail ( avec outlook) depuis excel avec piece jointe feuille active

Re,

En relisant ton premier post, ça doit donner quelque chose comme ça :

Private Sub Envoie_Mail_1()
Dim MonOutlook As Object, MonMessage As Object, Fichier As String
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)
Fichier = ThisWorkbook.Path & "\" & Format(Range("D14"), "yy-mm-dd") & " " & Range("g8") & " " & Format(Range("T14"), "0h00") & " " & Range("U1") & " " & Range("U2") & " " & Range("U3") & " " & Range("U4") & " " & Range("U5") & " " & Range("U6") & " " & Range("E15") & " " & Range("M14") _
& ".xls"
ActiveWorkbook.SaveAs Fichier
With MonMessage
  .to = Range("B5")
  .Cc = Range("B6")
  .Subject = Range("B63")
  .body = Range("G63")
  .Attachments.Add Fichier
  .send
End With
'si tu veux supprimer le fichier créé lors de la macro tu mets la ligne suivante
Kill Fichier
End Sub

A+

Martial