Contrôler un mot clé sur un PDF en pj avant envoi automatique par Excel

Bonjour,

j'ai besoin de votre aide svp .

j'ai ce code qui affiche un mail Outlook en ajoutant une pj en format PDF , prêt à être envoyer et qui fonctionne très bien sans soucis .

ce que je veux ajouter c'est un contrôle avant envoi de mail :

avant d'ajouter le PDF en pièce jointe , un code qui va chercher un mot clé à l'intérieur du PDF s'il la trouve il m'affiche le mail avec la pièce jointe sans soucis sinon s'il ne la trouve pas il m'affiche un message box sous forme d'alerte " mot clé non trouvé , veuillez vérifier le contenu de votre document"

je ne sais pas si c'est possible ou pas , je suis encore sous apprentissage

Sub Envoi_document() 'début du programme 'mail_outlook'

Dim OutApp As Object 'Déclaration de l'application objet Outlook
Dim OutMail As Variant 'Déclaration du mail objet Outlook
Dim Sht As Worksheet
Dim sPath As String, NomPj As String
Dim text1, text2 As String

' Définir la feuille à traiter
  Set Sht = ThisWorkbook.Sheets("feuil1")

    ' Définir la feuille à traiter
  Set Sht = ThisWorkbook.Sheets("GHA_FSVM")
  Set OutMail = CreateObject("Outlook.Application")
  Set OutApp = CreateObject("Outlook.Application")

  ' Chemin d'accès des pièces jointes
  sPath = "\\C:\mes documents\"

'textes pour le corps du message

text1 = "Bonjour,"
text2 = "Veuillez trouver ci-joint votre document."

'Créer unes instance outlook
  Set OutApp = CreateObject("Outlook.Application")

    'Créer une instance de mail
    With OutApp.Createitem(olMailItem)
      .SentOnBehalfOfName = "xxxxxxx.xxxx@xxx.com"
      .To = "xxxxxxx.xxxx@xxx.com" 'champ envoyer à
      .CC = "" 'champ mail en copie
      .BCC = "" 'champ mail en copie caché
      .Subject = "test"       'champ du sujet du mail

      'champs corps du mail HOMME
      .Body = Text1 & vbCrLf & vbCrLf & text2 _

       'Nom Pièce jointe
      NomPj = "test"

      'Vérifier si PJ existe, si oui l'ajouter
      If Dir(sPath & NomPj & ".pdf") <> "" Then .Attachments.Add sPath & NomPj & ".pdf"

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

     End With 'fin de la boucle

  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

bonjour,

je n'ai pas eu de réponse à mon sujet , ya t il un personne qui peut m'aider ?

Bonjour,

Ce n'est sans doute pas la meilleur façon de faire et ce n'est pas totalement en automatique.

Mais comme tu n'as pas eu d'autre solution depuis bientot 1 an peut-etre que ça peut t'aider.

Option Explicit

Public sPath As String, NomPj As String
Public Verif As Boolean

Sub Envoi_document() 'début du programme 'mail_outlook'

Dim OutApp As Object 'Déclaration de l'application objet Outlook
Dim OutMail As Variant 'Déclaration du mail objet Outlook
Dim Sht As Worksheet
Dim text1, text2 As String

' Définir la feuille à traiter
  Set Sht = ThisWorkbook.Sheets("feuil1")

    ' Définir la feuille à traiter
  Set Sht = ThisWorkbook.Sheets("GHA_FSVM")
  Set OutMail = CreateObject("Outlook.Application")
  Set OutApp = CreateObject("Outlook.Application")

  ' Chemin d'accès des pièces jointes
  sPath = "\\C:\mes documents\"

'textes pour le corps du message

text1 = "Bonjour,"
text2 = "Veuillez trouver ci-joint votre document."

'Créer unes instance outlook
  Set OutApp = CreateObject("Outlook.Application")

    'Créer une instance de mail
    With OutApp.Createitem(0) 'olMailItem
      .SentOnBehalfOfName = "xxxxxxx.xxxx@xxx.com"
      .to = "xxxxxxx.xxxx@xxx.com" 'champ envoyer à
      .CC = "" 'champ mail en copie
      .BCC = "" 'champ mail en copie caché
      .Subject = "test"       'champ du sujet du mail

      'champs corps du mail HOMME
      .Body = text1 & vbCrLf & vbCrLf & text2 _

       'Nom Pièce jointe
      NomPj = "test"

      'Vérifier si PJ existe, si oui l'ajouter
      If Dir(sPath & NomPj & ".pdf") <> "" Then
        Verif = False
        Search_PDF
        If Verif = True Then
            .Attachments.Add sPath & NomPj & ".pdf"
        Else
            MsgBox "mot clé non trouvé , veuillez vérifier le contenu de votre document"
            GoTo Verif_PJ_NO
        End If
      End If
      .Display 'affiche le mail en brouillon dans Outlook, pour vérifier avant d'envoyer
      '.Send 'envoie directement le mail
      '.Save 'sauvegarde le mail

     End With

Verif_PJ_NO:
  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

Sub Search_PDF()

    Dim Name_PDFfile, Name_AdobeCommand As String

    Const PDFXCHANGE As String = "C:\Program Files\Adobe\Acrobat DC\Acrobat\Acrobat.exe"
'    "C:\Program Files\Tracker Software\PDF Viewer\PDFXCview.exe"

    Name_PDFfile = sPath & NomPj & ".pdf"
    Name_AdobeCommand = " /a ""page=1=Open Actions"" "
    Shell PDFXCHANGE & Name_AdobeCommand & Chr(34) & Name_PDFfile & Chr(34), vbNormal
    Application.Wait (Now + TimeValue("0:00:05"))

    Application.SendKeys "^f", True
    Application.Wait (Now + TimeValue("0:00:01"))
    Application.SendKeys "Banane", True
    Application.Wait (Now + TimeValue("0:00:01"))
    Application.SendKeys "~", True
    Application.Wait (Now + TimeValue("0:00:03"))
    Application.SendKeys "{NUMLOCK}"

    If MsgBox("Mot trouvé ?", vbYesNo, "Demande de confirmation") = vbYes Then Verif = True

End Sub

Bien verifier que "Acrobat Reader" est sous cette adresse : (ou autre logiciel qui peut ouvrir un pdf comme PDFXChange adresse que j'ai mis en commentaire)

"C:\Program Files\Adobe\Acrobat DC\Acrobat\Acrobat.exe"

Pour l'exemple, le mot cherché est "Banane" si aucune correspondance, tu auras ce genre de message.

Et sur ton fichier Excel, que le texte cherché soit trouvé ou non, tu auras ce message

Et c'est a toi de dire oui ou non,

Si Oui traitemant du mail + PJ
Si Non message "mot clé non trouvé , veuillez vérifier le contenu de votre document" et pas de mail envoyé

A+