Macro pour envoie de mail

j'ai une macro pour l'envoie de mail avec pièce jointe en pdf qui fonctionne presque bien !

mon code :

Sub envoyer_Click() 'envoie de mail
    Fac_Dev = Sheets("facture").Range("I1")
    Fac_Num = Sheets("facture").Range("J1")
    chemin = Sheets("facture").Range("Q30")
    a = Sheets("facture").Range("Q31")
    b = Sheets("facture").Range("Q27")
    Dim messageHTML
    On Error GoTo errorHandler
    'on cré le fichier PDFdans le même dossier que le fichier source
    Sheets("facture").Range("$B$1:J53").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
   chemin & "\mail\" & Fac_Dev & Fac_Num & ".PDF" ' fichier pdf provisoir

    Set objMessage = CreateObject("CDO.Message")
    objMessage.Subject = "ci joint votres : " & Fac_Dev & Fac_Num  'objet du message
    objMessage.From = Sheets("facture").Range("Q29")
    objMessage.To = Sheets("facture").Range("mail")  'mail du destinataire
    objMessage.TextBody = Sheets("facture").Range("Q23") & vbCrLf & Range("Q24") & vbCrLf & Range("Q25") ' texte du message
    piece_jointe = chemin & "\mail\" & Fac_Dev & Fac_Num & ".PDF" ' pièce jointe
    messageHTML = "Ceci est un message en HTML"

    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = b ' " Q27 = smtp.orange.fr"  "Q28 = smtp.numericable.fr"
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = a
    objMessage.Configuration.Fields.Update

    objMessage.AddAttachment (piece_jointe) 'On ajoute la piéce jointe
    objMessage.Send
    MsgBox "Le mail a été bien envoyé !"
    'la feuille PDF créée est est supprimée après l'envoi
    Kill chemin & "\mail\" & Fac_Dev & Fac_Num & ".PDF" 'on suprime le la pièce jointe
    'si erreur on sort de la procédure
    Exit Sub
errorHandler:
    'description de l'erreur survenue
    MsgBox Err.Description

End Sub

mon problème est que la pièce jointe temporaire n'est supprimer qu'a la fermeture du classeur et non a la fin de la procedure , d'ailleur si j'éssai manuelement d'aller dans mon dossier mail ou ce trouve ma pièce jointe temporaire je ne peut pas la suprimer, windows me dit que je n'est pas les droits pour le faire, et que ce soit en tantque admin ou pas. et donc comme la piece temporaire est presente si j'éssai de renvoyer le document san fermer le classeur au préalable j'obtient un message d'erreur, erreur d'enregistrement le message na pas été envoyé.

aurriez vous une idée pour modifier cette ligne pour que le fichier temporaire soit supprimer aussitôt apres l'envoie et nom pas comme en ce momment a la fermeture du classeur :

   Kill chemin & "\mail\" & Fac_Dev & Fac_Num & ".PDF"

si joint mon fichier, pour que tous fonctionne il doit etre placer dans un dossier avec des sous dossier nommer : mail, archive factures, archive commandes et archive devis

et corriger dans la pages facture les cells : Q27 pour votre serveur sortant , Q30 pour le chemin de votre dossier et Q31 paramettre de remise courrier sortant

merci d'avance

48log-facture.xlsm (241.80 Ko)

bonjour et oui toujours avec mon petit problème !

apres de nombreuse tentatives infructueuses, je pense que mon fichier n'est pas supprimer imédiatement avec la fonction

Kill chemin & "\mail\" & Fac_Dev & Fac_Num & ".PDF"

car il reste selectionner par mon classeur. a votre avis quel instruction je pourrait placer juste avant pour que mon classeur libère le fichier ce qui lui permetrait de le supprimer en suivant et donc de pourvoir relancer mon code sans erreur autant de fois que je le souhaite

a vous lire

merci

re j'ai trouvé une piste pour resoudre mon problème mais il me reste un hic en suspend !

en 1 j'ai mon code pour envoyer par mail un fichier joint pdf, creer dans un dossier ( mail) avant l'envoie , et ca cela fonctionne tres bien la première fois mais pas en suivant et ce tanque le fichier joint existe j'ai donc tous essayer pour le supprimer une fois utiliser (kill, remove, etc..) rien n'y a fait car execl conserve ce ficher comme actif et donc ne le supprime qu'a la fermeture du classeur donc j'ai supprimer la fonction kill de mon code ce qui fait que execl libere le fichier après usage.

Sub envoyer_Click1() 'envoie de mail
    Fac_Dev = Sheets("recup").Range("I1")
    Fac_Num = Sheets("recup").Range("J1")
    chemin = Sheets("facture").Range("Q30")
    a = Sheets("facture").Range("Q31")
    b = Sheets("facture").Range("Q27")
    Dim messageHTML
    On Error GoTo errorHandler

    If Sheets("recup").Range("Q1") = "" Then
    MsgBox ("choisisez votre type de document, avec l'onglet transformer !")
        Exit Sub
        End If
    'on cré le fichier PDFdans le même dossier que le fichier source
    Sheets("recup").Range("$B$1:J53").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
   chemin & "\mail\" & Fac_Dev & Fac_Num & ".PDF" ' fichier pdf provisoir

    Set objMessage = CreateObject("CDO.Message")
    objMessage.Subject = "ci joint votres : " & Fac_Dev & Fac_Num  'objet du message
    objMessage.From = Sheets("facture").Range("Q29")
    objMessage.To = Sheets("recup").Range("R_mail")  'mail du destinataire
    objMessage.TextBody = Sheets("facture").Range("Q23") & vbCrLf & Range("Q24") & vbCrLf & Range("Q25") ' texte du message
    piece_jointe = chemin & "\mail\" & Fac_Dev & Fac_Num & ".PDF" ' pièce jointe
    messageHTML = "Ceci est un message en HTML"

    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = b ' " Q27 = smtp.orange.fr"  "Q28 = smtp.numericable.fr"
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = a
    objMessage.Configuration.Fields.Update

    objMessage.AddAttachment (piece_jointe) 'On ajoute la piéce jointe
    objMessage.Send
    MsgBox "Le mail a été bien envoyé !"
    Exit Sub

errorHandler:
    'description de l'erreur survenue
    MsgBox Err.Description

End Sub

donc jusque la tous va bien , j'ai donc crée une seconde macro qui supprime le fichier de mon dossier mail et elle aussi fonctionne parfaitement si je la lance via BVA (elle me supprime mon fichier pdf .

Sub SupprContenu()
 Dim Fic As String
 chemin = Sheets("facture").Range("Q30")
     Fic = Dir(chemin & "\mail\" & "*" & ".PDF")
     Do While Fic <> ""
         Kill chemin & "\mail\" & Fic
         Fic = Dir
     Loop
 End Sub

mais maintenant comment faire pour que a la fin de l'envoie de mon mail MsgBox "Le mail a été bien envoyé !" la seconde macro soit executer automatiquement car si je met SupprContenu.show en fin de ma première macro sa plante

merci d'avance pour vos suggestions

Rechercher des sujets similaires à "macro envoie mail"