joindre un fichier pdf à un email

nrdz83

XLDnaute Impliqué
Bonjour à tous

Voila dans le code ci dessous je fais une copie de ma feuille en PDF dans le même dossier que mon classeur source et j'essaye de l'envoyer par email.

Le problème est que je n'arrive pas à joindre ce fichier PDF a mon message.

Mon programme de messagerie s'ouvre bien avec les indications objet et sujet mais pas de pièce jointe.

Comment dois-je modifier ce code ?


Code:
Sub envoiemail()
If MsgBox("Êtes vous sur de vouloir envoyer le bon de préparation par email au format PDF  ?", vbQuestion + vbYesNo, "ENVOYER LE BON DE PREPARATION ...") = vbYes Then
    'création de la feuille au format  pdf
    'on cré le fichier PDF dans le même dossier que le fichier source
    
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ActiveWorkbook.Path & "\" & "Bon de préparation pour chantier.pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
    
    
    
    'envoie de l'email
    On Error Resume Next
    Err = 0
    ActiveWorkbook.FollowHyperlink Address:="mailto:" & _
    "?subject= Bon de préparation pour le chantier" & "  " & (Range("N5")) & _
    "&body=Bonjour, veuillez trouver en pièce jointe le bon de préparation pour le chantier" & "  " & (Range("N5"))
    If Err <> 0 Then MsgBox "Une Erreur s'est produite..."
End If
End Sub


Par avance merci
 

nrdz83

XLDnaute Impliqué
Re : joindre un fichier pdf à un email

Bon dimanche à tous

je reviens vers vous car malgré les deux bon liens de double zéro je n'arrive pas à l'adapter à mon problème.

J'arrive à créer le fichier avec la feuille en PDF dans le même dossier du classeur excel;
J'arrive à ouvrir mon logiciel de messagerie et y pré remplir l'objet, corps de message;
par contre je n'arrive toujours pas à y ajouter ma pièce jointe.

j'ai essayé ceci mais erreur me bloque

Code:
Sub envoiemail()
If MsgBox("Êtes vous sur de vouloir envoyer le bon de préparation par email au format PDF  ?", vbQuestion + vbYesNo, "ENVOYER LE BON DE PREPARATION ...") = vbYes Then
    'création de la feuille au format  pdf
    'on cré le fichier PDF dans le même dossier que le fichier source
    'avec comme nom bon de préparation nom du chantier et date récupérer en cellule N5
    
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ActiveWorkbook.Path & "\" & "Bon de préparation " & " " & (Range("N5")) & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
        
  'On attache le pdf au message mail
 piece_jointe = ActiveWorkbook.Path & "\" & "Bon de préparation " & " " & (Range("N5")) & ".pdf" ' bon de préparation en pdf
 objMessage.AddAttachment (piece_jointe) 'On ajoute la piéce jointe, il est possible d'envoyer plusieurs pièces
 
 
    'envoie de l'email
    On Error Resume Next
    Err = 0
    ActiveWorkbook.FollowHyperlink Address:="mailto:" & _
    "?subject= Bon de préparation pour le chantier" & "  " & (Range("N5")) & _
    "&body=Bonjour, veuillez trouver en pièce jointe le bon de préparation pour le chantier" & "  " & (Range("N5"))
    If Err <> 0 Then MsgBox "Une Erreur s'est produite..."
End If
End Sub

Par avance merci pour vos lumières
 
C

Compte Supprimé 979

Guest
Re : joindre un fichier pdf à un email

Bonsoir Nrdz83

Question 1 : Quel est ton logiciel de messagerie ?
Question 2 : Passes-tu par un proxy (cas en général dans une société)

De toute façon un "FollowHyperlink" ne permet pas de joindre un fichier ;)

A+
 
C

Compte Supprimé 979

Guest
Re : joindre un fichier pdf à un email

Re,

Si tu utilises Windows Live Mail, il faut je pense, passer par la méthode CDO

Voici le code à tester :
Code:
' Utilisation de la méthode CDO : Collaboration Data ObjectsSub CDO_EnvoiMail_AvecPieceJointe()
  Dim sPath As String, sFic As String
  Dim Flds As Object, iConf As Object, iMsg As Object
  ' Initialisation des variables
  sPath = ActiveWorkbook.Path & "\"
  sFic = "Bon de préparation pour chantier.pdf"
  '    Dim Flds As Variant
  If MsgBox("Êtes vous sur de vouloir envoyer le bon de préparation par email au format PDF  ?", _
            vbQuestion + vbYesNo, "ENVOYER LE BON DE PREPARATION ...") = vbNo Then Exit Sub
  'création de la feuille au format  pdf
  'on cré le fichier PDF dans le même dossier que le fichier source
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & sFic, _
                                  Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                  IgnorePrintAreas:=False, OpenAfterPublish:=False
  ' Désactiver l'écran et les évènements
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
  End With
  ' Créer la configuration d'envoi des mails
  Set iConf = CreateObject("CDO.Configuration")
  iConf.Load -1    ' CDO Source Defaults
  Set Flds = iConf.Fields
  With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1  'cdoBasic
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Adresse mail complète"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Mot de passe messagerie"  ' Ne doit pas servir !?
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp du fournisseur d'accès"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    .Update
  End With
  ' Création du message avec pièce jointe
  Set iMsg = CreateObject("CDO.Message")
  With iMsg
    Set .Configuration = iConf
    .To = "destinataire@free.fr"
    .From = """Moi"" <BrunoM45@something.fr>"
    .Subject = "Ceci est l'objet du message"
    .AddAttachment sPath & sFic  ' Attachement du fichier
    .TextBody = "Texte du corps du message" & vbNewLine _
              & "Ligne 2"
    .Send
  End With
  Set iMsg = Nothing
  ' On supprime ensuite, si on le souhaite, le fichier
  Kill sPath & sFic


  With Application
    .ScreenUpdating = True
    .EnableEvents = True
  End With
End Sub

A+
 
Dernière modification par un modérateur:

nrdz83

XLDnaute Impliqué
Re : joindre un fichier pdf à un email

Bonsoir brunoM45 le fil

je te remercie pour ton aide.

j'ai une erreur au niveau de .Send

d'ou cela peut il provenir?

j'ai essayé iMsg.Send et Item.Send mais ça ne marche pas

Merci pour tes lumières
 

nrdz83

XLDnaute Impliqué
Re : joindre un fichier pdf à un email

Bonsoir bruno j'ai mis smtp.sfr.fr
Je comprends plus là ça plante plus mais le message par pas grrrrr

J'ai essayé d'utiliser l'enregistreur de macro ça m'ouvre mon logiciel de messagerie et ça me joint mon classeur en pièce jointe.
J'ai modifié le code pour faire que la feuille en pdf.
ce qui me donne ce code >>>>
Code:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ActiveWorkbook.Path & "\" & "Bon de préparation " & " " & (Range("N5")) & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False

  
    Application.Dialogs(xlDialogSendMail).Show


et si j'utilise ce code ça m'ouvre mon logiciel de messagerie mais avec la pièce jointe en .xlsm grrrr j'en perd mon latin

merci pour les tuyaux
 
C

Compte Supprimé 979

Guest
Re : joindre un fichier pdf à un email

Re,

Chez SFR il faut mettre l'adresse mail de l'expéditeur
Nom des serveurs de messagerie

Alors il faut ajouter ces 2 lignes après la première (voir post #8)
Code:
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Adresse mail complète"    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Mot de passe messagerie"  ' Ne doit pas servir !?

A+
 

nrdz83

XLDnaute Impliqué
Re : joindre un fichier pdf à un email

Bonjour à tous et bon week-end de pâques

Voila devant la compléxité entre les différents logiciels de messagerie je me suis rabattu sur OUTLOOK et j'ai ce code >>>
Code:
' Dans l'éditeur VBA: Faire Menu / Outils / Reference / Cocher "Microsoft Outlook Library"
Sub Envoyer_Mail_Outlook()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String

If MsgBox("Êtes vous sur de vouloir envoyer le bon de préparation par email au format PDF  ?", vbQuestion + vbYesNo, "ENVOYER LE BON DE PREPARATION ...") = vbYes Then
    'création de la feuille au format  pdf
    'on cré le fichier PDF dans le même dossier que le fichier source
    'avec comme nom bon de préparation nom du chantier et date récupérer en cellule N5
    
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ActiveWorkbook.Path & "\" & "Bon de préparation " & " " & (Range("N5")) & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False

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

'---------------------------------------------------------
   ' entrer le path  du fichier
   Nom_Fichier = ActiveWorkbook.Path & "\" & "Bon de préparation " & " " & (Range("N5")) & ".pdf" ' bon de préparation en pdf
    If Nom_Fichier = "" Then Exit Sub
'---------------------------------------------------------
     With oBjMail
        .To = "" ' le destinataire
       .Subject = "Bon de préparation pour le chantier" & "  " & (Range("N5")) ' l'objet du mail
       .Body = "Bonjour, veuillez trouver en pièce jointe le bon de préparation pour le chantier" & "  " & (Range("N5"))   'le corps du mail ..son contenu
       .Attachments.Add Nom_Fichier 'La feuille PDF bon de préparation créée dans le dossier
       .Display  '  
       '.Send 'send permet d'envoyer le message
    End With
    ObjOutlook.Quit
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
End If
End Sub

Il fonctionne par contre j'ai toujours ce message de confirmation qui s'affiche

2013-04-01_112830.jpg

Comment faire pour le supprimer ?
Si je supprime .Display OUTLOOK ne s'ouvre pas.

Par avance merci pour votre aide
 

Discussions similaires

Statistiques des forums

Discussions
312 330
Messages
2 087 340
Membres
103 524
dernier inscrit
Smile1813