Mail pj avec condition

Le 06/01/2017 à 11:25

Bonjour

J'utilise une macro pour envoyer une mail et une PJ qui fonctionne mais souhaiterais la modifier pour qu'elle envoi une ou plusieurs feuille sous condition:

SI les case E8 contiennent du texte , la macro crée une copie de cette feuille(P1/P2/P3/P4) dans un nouveau classeur qui est ajouté ensuite en PJ

Merci de votre aide mon niveau est trop bas .

6teste-mail.xlsm (40.47 Ko)
Le 08/01/2017 à 19:04

Toujours bloqué dessus, merci de l'attention portée à ma demande.

Le 09/01/2017 à 16:15

Hello Gazmat,

Voici une proposition en P.J.

Attention, Dans l'éditeur VBA: Faire Menu / Tools / Reference / Cocher "Microsoft Outlook Library"

Dis-moi si cela fonctionne pour toi.

Sub Envoi_PJ_Ongl()
'
' Envoi_PJ_Ongl
'Déclaration des variables
Dim FILE_NAME, DOSSIER, ToMAIL As String
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Feuille_selection As Worksheet
Dim i As Integer
Dim prov() As Variant
nbFeuil = 0

'Chargement des paramètres :
FILE_NAME = Range("FILE_NAME").Value ' name
DOSSIER = Range("DOSSIER").Value ' path
ToMAIL = Range("ToMail").Value ' mail destinaire
SAVE_NAME = DOSSIER & FILE_NAME

'Boucle de test de la présence d'une valeur en "E8"
For i = 1 To Sheets.Count - 1
    If Sheets(i + 1).Range("E8").Value <> "" Then
        ReDim Preserve prov(nbFeuil)
        prov(nbFeuil) = Sheets(i + 1).Name
        nbFeuil = nbFeuil + 1
    End If
Next

'Msg selections
MsgBox nbFeuil & "feuille(s) contiennent des valeurs en E8."

'Si test = 0
If nbFeuil = 0 Then
    MsgBox "Aucune feuille ne présente de valeur en E8."
    Exit Sub
End If

'Selction & copie des feuilles voulues
Sheets(prov).Select
Sheets(prov).Copy
    ActiveWorkbook.SaveAs Filename:=DOSSIER & FILE_NAME, _
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Workbooks(FILE_NAME).Close False

    Windows("Test Mail.xlsx").Activate
    Sheets("PG").Select

'GENERER MAIL

'Il faut activer la référence "Microsoft Outlook Library" Avant de lancer cette macro,
' Dans l'éditeur VBA: Faire Menu / Tools / Reference / Cocher "Microsoft Outlook Library"

    Set ObjOutlook = New Outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)

'entrer le path et nom du fichier autrement
    If SAVE_NAME = "" Then Exit Sub
'---------------------------------------------------------
     With oBjMail
        .To = ToMAIL ' le destinataire
       .Subject = "Ici c'est l'objet"    ' l'objet du mail
       .Body = "Bonjour, Voici en P.J la copie des onglets correspondant au critère indiqué "  'le corps du mail ..son contenu
       .Attachments.Add SAVE_NAME  'ou Nomfichier
       .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
       .Send
     MsgBox "Message envoyé."
    End With

End Sub

Bye.

6test-mail.xlsm (33.63 Ko)
Le 10/01/2017 à 15:36

Merci pour ta réponse pour ma part j'ai travaillé dessus le temps d'avoir une réponse et je suis resté bloqué a une étape .

Si je peut me permettre bien que ta réponse me convienne. J'aimerais trouver l'erreur pour ma méthode

C'est concernant la piece joint (texte rouge) je n'arrive pas a trouver le chemin pour mettre en pièce jointe le classeur que je crée avec les copie des feuilles.

Vu qu'il n'est pas enregistré je ne sais pas comment ajouter un fichier crée temporairement.

Sub EnvoiPage()

'Set nomclas = Object

If Sheets("Location").Cells(8, 5) <> "" Or Sheets("Pose compteur").Cells(8, 5) <> "" _

Or Sheets("Enlevement compteur").Cells(8, 5) <> "" Then

nomclas = ""

'

If Sheets("Location").Cells(8, 5) <> "" Then

Sheets("Location").Select

Sheets("Location").Copy

nomclas = ActiveWorkbook.Name

End If

Windows("Copie de PCN3.xlsm").Activate

If Sheets("Pose compteur").Cells(8, 5) <> "" Then

Sheets("Pose compteur").Select

If nomclas <> "" Then

Sheets("Pose compteur").Copy Before:=Workbooks(nomclas).Sheets(1)

Else

Sheets("Pose compteur").Copy

nomclas = ActiveWorkbook.Name

End If

End If

Windows("Copie de PCN3.xlsm").Activate

If Sheets("Enlevement compteur").Cells(8, 5) <> "" Then

Sheets("Enlevement compteur").Select

If nomclas <> "" Then

Sheets("Enlevement compteur").Copy After:=Workbooks(nomclas).Sheets(2)

Else

Sheets("Pose compteur").Copy

nomclas = ActiveWorkbook.Name

End If

End If

End If

If nomclas = "" Then

MsgBox ("pas de feuilles")

GoTo fin

End If

chemin = Workbooks(nomclas).Names.Application.Path

Dim Destinataires(3) As String, Sujet As String

Dim AccuseReception As Boolean

'Modifier les mails des destinataires

Destinataires(1) = "aaaaa@aaaaaa"

'

Sujet = "Commande GIC"

AccuseReception = True

'Nom de la feuille (remplacer Recap par celui de la Feuille à envoyer)

Set ol = New Outlook.Application

With ol

'Set olMail = ol.CreateItem(olMailItem)

[size=150]Attachments.Add ThisWorkbook.Path & "\" & ThisWorkbook.Name

[/size] End With

'ThisWorkbook.Sheets("Commande").Copy

'ThisWorkbook.Sheets("Location").Copy

ActiveWorkbook.SendMail Destinataires, Sujet, AccuseReception

ActiveWorkbook.Close False

fin:

End Sub

Le 11/01/2017 à 09:52

Bonjour,

Peux-tu préciser où est le blocage de ton code ? (PS : Merci d'utilise la mise en forme "CODE" du forum afin que les lignes soient plus lisibles. )

La commande ci-dessous après la copie des feuilles enregistre sous le nom & l'emplacment voulus. tu n'as plus qu'à reprendre ce nom pour l'indiquer en P.J.

Soit tu indiques le nom à utiliser directement dans le code "c\:......xlsx", soit comme dans mon exemple tu l'inscrit dans une cellule du fichier que tu nommes et à laquelle tu vas faire référence dans ton.

ActiveWorkbook.SaveAs Filename:=indique le chemin complet+ le nom, _
Sub EnvoiPage()

'Set nomclas = Object

If Sheets("Location").Cells(8, 5) <> "" Or Sheets("Pose compteur").Cells(8, 5) <> "" _
Or Sheets("Enlevement compteur").Cells(8, 5) <> "" Then

nomclas = "" '
'
If Sheets("Location").Cells(8, 5) <> "" Then
Sheets("Location").Select
Sheets("Location").Copy
nomclas = ActiveWorkbook.Name

End If

Windows("Copie de PCN3.xlsm").Activate

If Sheets("Pose compteur").Cells(8, 5) <> "" Then
Sheets("Pose compteur").Select
If nomclas <> "" Then
Sheets("Pose compteur").Copy Before:=Workbooks(nomclas).Sheets(1)
Else
Sheets("Pose compteur").Copy
nomclas = ActiveWorkbook.Name
End If
End If

Windows("Copie de PCN3.xlsm").Activate

If Sheets("Enlevement compteur").Cells(8, 5) <> "" Then
Sheets("Enlevement compteur").Select
If nomclas <> "" Then
Sheets("Enlevement compteur").Copy After:=Workbooks(nomclas).Sheets(2)
Else
Sheets("Pose compteur").Copy
nomclas = ActiveWorkbook.Name
End If
End If
End If

If nomclas = "" Then
MsgBox ("pas de feuilles")
GoTo fin
End If

chemin = Workbooks(nomclas).Names.Application.Path
Dim Destinataires(3) As String, Sujet As String
Dim AccuseReception As Boolean
'Modifier les mails des destinataires
Destinataires(1) = "aaaaa@aaaaaa"
'
Sujet = "Commande GIC"
AccuseReception = True
'Nom de la feuille (remplacer Recap par celui de la Feuille à envoyer)

Set ol = New Outlook.Application
With ol
'Set olMail = ol.CreateItem(olMailItem)

Attachments.Add ThisWorkbook.Path & "\" & ThisWorkbook.Name
'.Attachments.Add = ActiveWorkbook ' "\" & nomclas & ".xlsx"
End With
'ThisWorkbook.Sheets("Commande").Copy
'ThisWorkbook.Sheets("Location").Copy
ActiveWorkbook.SendMail Destinataires, Sujet, AccuseReception
ActiveWorkbook.Close False

fin:

End Sub
Rechercher des sujets similaires à "mail condition"