Insérer une piéce jointe dans un mail sous conditions d'Excel

j'ai besoin de vos aides pour insérer une pj dans un mail qui s'affiche à l'aide d'un macro

besoin : le nom de la pj = cellule G2

le macro doit chercher la pj sur le lien "mes documents" , s'il la trouve , il insere dans le mail

et ainsi de suite pour les autres lignes G3 , G4 ......

pour infos : tous les autres fonctions marche tres bien ( to , cc, bcc body ect.....)

Dim OutApp As Object 'Déclaration de l'application objet Outlook
Dim OutMail As Variant 'Déclaration du mail objet Outlook

Set OutMail = CreateObject("Outlook.Application")

For ligne = 2 To 30

If Range("J" & ligne) = "M" Then

With OutMail.CreateItem(olMailItem) 'début de la boucle

.SentOnBehalfOfName = "xxxx.yyyy@gmail.com"
.To = Range("T" & ligne) 'champ envoyer à
.CC = "xxxxx.yyyyy@gmail.com" 'champ mail en copie
.BCC = "" 'champ mail en copie caché
.Subject = Range("N" & ligne) 'champ du sujet du mail
.Body = "Bonjour Monsieur," & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L7") & Chr(13) & Chr(10) & Range("L8") & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L9") & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L10") & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L11") & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L12")'champ du corps du mail

If xxxxxxxxxxxxxx Then
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

End If

.Display 'affiche le mail en brouillon dans Outlook, pratique
'pour vérifier avant d'envoyer
'.Send 'envoie directement le mail
'.Save 'sauvegarde le mail

End With 'fin de la boucle

End If

Next ligne

Set OutMail = Nothing 'nettoie la mémoire en nettoyant les variables
Set OutApp = Nothing 'nettoie la mémoire en nettoyant les variables

End Sub 'fin du programme

Bonjour,

Voici un essai :

Sub MAcro()
Dim OutApp As Object 'Déclaration de l'application objet Outlook
Set OutApp = CreateObject("Outlook.Application")
For ligne = 2 To 30
    If Range("J" & ligne) = "M" Then
        With OutApp.CreateItem(olMailItem) 'début de la boucle
            .SentOnBehalfOfName = "xxxx.yyyy@gmail.com"
            .To = Range("T" & ligne) 'champ envoyer à
            .CC = "xxxxx.yyyyy@gmail.com" 'champ mail en copie
            .BCC = "" 'champ mail en copie caché
            .Subject = Range("N" & ligne) 'champ du sujet du mail
            .Body = "Bonjour Monsieur," & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L7") & Chr(13) & Chr(10) & Range("L8") & Chr(13) & Chr(10)             & Chr(13) & Chr(10) & Range("L9") & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L10") & Chr(13) & Chr(10) & Chr(13) & Chr(10) &             Range("L11") & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L12")'champ du corps du mail
            If range("G2") = pj Then '??? D'ou vient pj ???
                if dir(pj) <> "" then .attachments.add pj
            End If
            .Display 'affiche le mail en brouillon dans Outlook, pratique
            'pour vérifier avant d'envoyer
            '.Send 'envoie directement le mail
            '.Save 'sauvegarde le mail
        End With 'fin de la boucle
    End If
Next ligne
Set OutApp = Nothing 'nettoie la mémoire en nettoyant les variables
End Sub 'fin du programme

Encore reste-t-il à définir l'origine de pj (il faut le chemin complet).

Cdlt,

Bonjour ghazi17 et

Une petite présentation ICI serait la bienvenue

Je vous invite vivement à lire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum et notamment :

  • Pour plus de lisibilité, utilisez la fonctionnalité pour insérer vos codes VBA (et si possible aussi pour vos formules Excel).

Merci d'y faire attention SVP

Cordialement

bonjour 3GB,

merci ton retour .

le chemin est C:\ user\mes documents

malheureusement ça ne fonctionne pas , la pj qui correspond au nom de la cellule G2 ou G3 ne s'ajoute en automatique pour chaque mail afficher

peux tu essayer autre solution ?, je n'ai pas pu joindre le fichier test dans le message.

merci d'avance

Bonjour ghazi17, Salut Bruno ,

Voici un nouvel essai en considérant que le nom du fichier est en G2 (de la feuille active) et que le répertoire est Documents :

Sub MAcro()
Dim OutApp As Object 'Déclaration de l'application objet Outlook
Set OutApp = CreateObject("Outlook.Application")
pj = environ("userprofile") & "\Documents\" & range("G2").value
For ligne = 2 To 30
    If Range("J" & ligne) = "M" Then
        With OutApp.CreateItem(olMailItem) 'début de la boucle
            .SentOnBehalfOfName = "xxxx.yyyy@gmail.com"
            .To = Range("T" & ligne) 'champ envoyer à
            .CC = "xxxxx.yyyyy@gmail.com" 'champ mail en copie
            .BCC = "" 'champ mail en copie caché
            .Subject = Range("N" & ligne) 'champ du sujet du mail
            .Body = "Bonjour Monsieur," & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L7") & Chr(13) & Chr(10) & Range("L8") & Chr(13) & Chr(10)             & Chr(13) & Chr(10) & Range("L9") & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L10") & Chr(13) & Chr(10) & Chr(13) & Chr(10) &             Range("L11") & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L12")'champ du corps du mail
            if dir(pj) <> "" then .attachments.add pj
            .Display 'affiche le mail en brouillon dans Outlook, pratique
            'pour vérifier avant d'envoyer
            '.Send 'envoie directement le mail
            '.Save 'sauvegarde le mail
        End With 'fin de la boucle
    End If
Next ligne
Set OutApp = Nothing 'nettoie la mémoire en nettoyant les variables
End Sub 'fin du programme

Si ça ne marche pas, il faudra être un peu plus précis car je ne peux pas deviner où les chemins de vos fichiers.

Cdlt,

25base-mail-test.xlsm (25.35 Ko)

oui effectivement tu as raison je dois être plus explicite , j'ai réussi à joindre le fichier test et je t'ai mis une seul ligne pour ne pas afficher trop d'information.

en fait tu vas remarquer que sur la colonne "G2" il y a le texte " 1234_555_dupond daniel 12-2-2022- Convocation" , celui ci est le nom de la pièce jointe sur le chemin indiqué en format PDF : c:\user\mes documents.

le besoin c'est que le macro doit trouver automatiquement la pj sous ce nom et l'insérer dans le mail à envoyer en automatique.

le principe doit être le même s'il y aura d'autres ligne ( G3 , G4 ect......)

je ne sais si ma demande est possible ou pas ? :)

Bonjour ghazi17, 3GB

Voici le code "corrigé", en revanche je ne comprends pas comment vous pouvez aller chercher des valeurs dans les cellules L7 à L12
tout en parcourant les lignes de 2 à XX

Il vaudrait mieux mettre ces valeurs dans une feuille annexe, non !?

Option Explicit ' Rendre obligatoire la définition des variables
' cela évite les erreur de noms et permet un débogage plus facile

Const olMailItem As Integer = 0

Sub mail_envoie_convocation() 'début du programme 'mail_outlook'
  Dim OutApp As Object 'Déclaration de l'application objet Outlook
  Dim OutMail As Object 'Déclaration du mail objet Outlook
  Dim dLig As Long, Lig As Long
  Dim sPath As String, NomPj As String
  Dim Sht As Worksheet
  ' Définir la feuille à traiter
  Set Sht = ThisWorkbook.Sheets("LISTE SUIVIE")
  ' Chemin d'accès des pièces jointes
  sPath = Environ("userprofile") & "\Documents\"
  ' Créer unes instance outlook
  Set OutApp = CreateObject("Outlook.Application")
  ' Dernière ligne remplie de la feuille
  dLig = Sht.Range("A" & Rows.Count).End(xlUp).Row
  ' Pour chaque ligne
  For Lig = 2 To dLig
    ' Si pas de M on passe la ligne
    If Sht.Range("J" & Lig) <> "M" Then GoTo SuiteLigne
    ' Créer une instance de mail
    With OutApp.Createitem(olMailItem)
      .SentOnBehalfOfName = "sssss.ssssss@gmail.com"
      .To = Sht.Range("I" & Lig) 'champ envoyer à
      .CC = "sssss.sssssss@gmail.com; xxxxx.hsssss@gmail.com" 'champ mail en copie
      .BCC = "" 'champ mail en copie caché
      .Subject = Sht.Range("N" & Lig) 'champ du sujet du mail
      ' *** ATTENTION ***
      ' ICI je n'est pas bien compris pourquoi on parcours les lignes de 2 à X
      ' Et que l'on va chercher des informations dans les lignes 7 à 12 !???
      ' *****************
      .Body = "Bonjour Monsieur Madame," & vbCrLf & vbCrLf _
        & Sht.Range("L7") & vbCrLf & Sht.Range("L8") & vbCrLf & vbCrLf & Sht.Range("L9") _
        & vbCrLf & vbCrLf & Sht.Range("L10") & vbCrLf & vbCrLf & Sht.Range("L11") _
        & vbCrLf & vbCrLf & Sht.Range("L12")
      ' Nom Pièce jointe
      NomPj = Sht.Range("G" & Lig).Value
      ' Vérifier si PJ existe, si oui l'ajouter
      If Dir(sPath & NomPj) <> "" Then .Attachments.Add sPath & NomPj
      '
      .Display 'affiche le mail en brouillon dans Outlook, pratique
      'pour vérifier avant d'envoyer
      '.Send 'envoie directement le mail
      '.Save 'sauvegarde le mail
    End With 'fin de la boucle
SuiteLigne:
  Next Lig

  Set OutMail = Nothing 'nettoie la mémoire en nettoyant les variables
  Set OutApp = Nothing 'nettoie la mémoire en nettoyant les variables
  Set Sht = Nothing
End Sub  'fin du programme

A+

Bonjour Bruno,

Merci pour ton implication, je vais le tester et je te tiens au cours.( Remerciement aussi pour 3GB).

Pour répondre à ta question " L7 à L12 " : j'avais des textes ( phrases + signature) pour le corps du mail que j'ai supprimé et je vous ai mis une seul ligne L7 juste pour tester , par contre tu as raison je vais les déclarer dans le macro puisque les textes sont constant pour tous les destinataires comme ça ils seront invisible.

pour infos je suis en cours d'apprentissage.

Bonsoir Bruno,

la pj ne s'ajoute pas , je crois qu'il y a un soucis de chemin.

je vais essayer sur mon laptop professionnel , par contre je ne sais pas si ça diffère ou pas et s'il y a d'autres fonction VBA pour des liens sur un serveur ,en tout cas voici le chemin :

"\\FS01.com\societyFiles\OTN\OTNFiles\23_IJEDI\100- CLIENTS_TN\client\2022\GESTION DES VISITES \CONVOCATIONS"

s'il y une fonction spécifique pour un réseau professionnel , je te prie de ma faire part si c'est possible .

merci d'avance

Bonsoir ghazi17

Si vous utilisez un lien UNC pour accéder aux fichiers, cela ne peut effectivement pas marcher avec Dir()

Pourquoi ne pas connecter un lecteur ?

A+

ces des lecteurs réseau sur des serveurs bien sur , nous avons des restrictions sur le pc .

en faite je reviens vers vous , par contre une bonne nouvelle, s'est avérés que ce n'est pas un soucis de lien car j'ai testé avec le lien + le nom de la pj comme suit :

"\\FS01.com\societyFiles\OTN\OTNFiles\23_IJEDI\100- CLIENTS_TN\client\2022\GESTION DES VISITES \CONVOCATIONS\1234_555_dupond daniel 12-2-2022- Convocation.pdf"

==> le mail s'affiche avec la pièce jointe en pdf , mais ce n'est pas ce processus que je cherche , le macro doit trouver le PDF tout seul en fonction du nom de la cellule G2 ou G3 ect ......

en supprimant ce que tu as ajouté.

Dim sPath As String, NomPj As String

' Chemin d'accès des pièces jointes

sPath = Environ("userprofile") & "\Documents\"

' Nom Pièce jointe

NomPj = Sht.Range("G" & Lig).Value

' Vérifier si PJ existe, si oui l'ajouter

If Dir(sPath & NomPj) <> "" Then .Attachments.Add sPath & NomPj

maintenant pouvez vous avoir autre moyen ?, je suis entrain de chercher avec vous , n'hésitez pas , merci d'avance

Bonjour à tous,

Dans ce cas, il suffit de modifier sPath a priori :

sPath = "\\FS01.com\societyFiles\OTN\OTNFiles\23_IJEDI\100- CLIENTS_TN\client\2022\GESTION DES VISITES \CONVOCATIONS\"

Attention aux espaces indésirables !

Cdlt,

Bonjour 3GB,

IDEM j'ai déjà essayé hier d'enlever " environ " et mettre seulement le lien entre guillemets sans Espace.

Vous avez le fichier en PJ et Outlook je suis pose .

Est ce que vous avez testé sur vos pc ?

en plus tous les vidéos sur YouTube montre qu'ils ont mis le nom de la piece avec le lien.

je cherche encore.......je ne trouve de solution.

Non, désolé, je n'ai pas testé, je n'ai pas Outlook. Je pense que c'est un problème de chemin mal orthographié car Bruno comme moi avons déjà résolu des sujets similaires par le passé sans problème particulier.

C'est à vous de faire les tests malheureusement.

Bon courage,

Bonjour,

Je comprends mais comment ça se fait qu'il l'ajoute quand je saisi le nom de la PJ avec le chemin ,cela veut dire que le chemin est correcte ainsi que le nom de la PJ.

pouvez vous m'envoyer quelques liens résolu sur ce forum pour ce genre de cas ?

merci d'avance.

Non, je n'ai pas de lien à vous envoyer, mais ils sont probablement trouvables en faisant un recherche avec des mots-clé.

Votre problème signifie que le nom du fichier n'est pas bien saisi en G2 ou qu'en effet, la fonction dir ne fonctionne pas correctement avec un chemin UNC comme l'a dit Bruno. Ce sont 2 points que je ne peux pas vérifier et qui sont certainement à votre portée.

Le plus rapide est d'enlever le test d'existence du fichier :

Option Explicit ' Rendre obligatoire la définition des variables
' cela évite les erreur de noms et permet un débogage plus facile

Const olMailItem As Integer = 0

Sub mail_envoie_convocation() 'début du programme 'mail_outlook'
  Dim OutApp As Object 'Déclaration de l'application objet Outlook
  Dim OutMail As Object 'Déclaration du mail objet Outlook
  Dim dLig As Long, Lig As Long
  Dim sPath As String, NomPj As String
  Dim Sht As Worksheet
  ' Définir la feuille à traiter
  Set Sht = ThisWorkbook.Sheets("LISTE SUIVIE")
  ' Chemin d'accès des pièces jointes
  sPath = "\\FS01.com\societyFiles\OTN\OTNFiles\23_IJEDI\100- CLIENTS_TN\client\2022\GESTION DES VISITES \CONVOCATIONS\"
  ' Créer unes instance outlook
  Set OutApp = CreateObject("Outlook.Application")
  ' Dernière ligne remplie de la feuille
  dLig = Sht.Range("A" & Rows.Count).End(xlUp).Row
  ' Pour chaque ligne
  For Lig = 2 To dLig
    ' Si pas de M on passe la ligne
    If Sht.Range("J" & Lig) <> "M" Then GoTo SuiteLigne
    ' Créer une instance de mail
    With OutApp.Createitem(olMailItem)
      .SentOnBehalfOfName = "sssss.ssssss@gmail.com"
      .To = Sht.Range("I" & Lig) 'champ envoyer à
      .CC = "sssss.sssssss@gmail.com; xxxxx.hsssss@gmail.com" 'champ mail en copie
      .BCC = "" 'champ mail en copie caché
      .Subject = Sht.Range("N" & Lig) 'champ du sujet du mail
      ' *** ATTENTION ***
      ' ICI je n'est pas bien compris pourquoi on parcours les lignes de 2 à X
      ' Et que l'on va chercher des informations dans les lignes 7 à 12 !???
      ' *****************
      .Body = "Bonjour Monsieur Madame," & vbCrLf & vbCrLf _
        & Sht.Range("L7") & vbCrLf & Sht.Range("L8") & vbCrLf & vbCrLf & Sht.Range("L9") _
        & vbCrLf & vbCrLf & Sht.Range("L10") & vbCrLf & vbCrLf & Sht.Range("L11") _
        & vbCrLf & vbCrLf & Sht.Range("L12")
      ' Nom Pièce jointe
      NomPj = Sht.Range("G" & Lig).Value
      ' Vérifier si PJ existe, si oui l'ajouter
      'If Dir(sPath & NomPj) <> "" Then '<<<<<<<<<<< condition désactivée
        .Attachments.Add sPath & NomPj
      '
      .Display 'affiche le mail en brouillon dans Outlook, pratique
      'pour vérifier avant d'envoyer
      '.Send 'envoie directement le mail
      '.Save 'sauvegarde le mail
    End With 'fin de la boucle
SuiteLigne:
  Next Lig

  Set OutMail = Nothing 'nettoie la mémoire en nettoyant les variables
  Set OutApp = Nothing 'nettoie la mémoire en nettoyant les variables
  Set Sht = Nothing
End Sub  'fin du programme

Et éventuellement de mettre une gestion d'erreur par la suite.

Cdlt,

bonjour à tous ,

Après quelques manips , j'ai pu trouvé la solution :

j'ai crée deux colonnes sur le fichier que j'ai masqué ,:

* la 1° comporte Nompj.pdf =G2&(".pdf") ==> colonne ("R")

* la 2° comporte =[@[sPath + Nompj.pdf]] ==> colonne ("Q")

j'ai supprimé cette déclaration dans le macro : sPath = "\\FS01.com\societyFiles\OTN\OTNFiles\23_IJEDI\100- CLIENTS_TN\client\2022\GESTION DES VISITES \CONVOCATIONS\"

et j'ai modifié le processus ci dessous :

'Nom de la pièce jointe

NomPj = Sht.Range("Q" & Lig).Value

' Vérifier si PJ existe, si oui l'ajouter

If Sht.Range("Q" & Lig).Value = NomPj Then
.Attachments.Add NomPj

Maintenant la piece jonte s'ajoute au mail qui correspond a chaque nom et prénom

Merci pour vos implications , bon courage et a bientôt

Rechercher des sujets similaires à "inserer piece jointe mail conditions"