envoie fichier joint en pdf

[Tail]

bonjour,

j'ai un fichier excel, et j'aimerai le transformer en pdf et l'envoyer en pièce jointe.

j'ai trouvé des codes ici que j'ai pu adapter mais je bloque sur 2 erreurs.

il me dit qu'il ne peut pas lancer pdf créator, et que le fichier spécifié est introuvable.

voici le code merci de votre aide :

Private Sub Workbook_BeforePrint(Cancel As Boolean)
'ActiveSheet.PrintOut
ActiveSheet.PageSetup.PrintArea = "$A$1:$H$104"

Dim repertoire As String
Dim Fichier As String
Dim Extension As String


repertoire = "C:\docs communs\ops\archive rapports 2013\"
Extension = ".pdf"
Fichier = " " & "N° CAU " & Cells(3, 3).Value
ActiveWorkbook.SaveAs Filename:= _
repertoire & Fichier & Extension _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
msg = MsgBox("Y a t il un conventionné dans l'effectif ?", vbYesNo, "Conventionné")
If msg = vbYes Then GoTo 100 Else GoTo 300
100 Rows("105:159").Select
Selection.EntireRow.Hidden = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$H$159"
Rows("140:145").Select
Selection.EntireRow.Hidden = True
300 On Error GoTo errorHandler
Dim messageHTML
Set objmessage = CreateObject("CDO.Message")
objmessage.Subject = "Sortie de secours (Message Automatique)"
objmessage.From = "xxxxx@xxx.fr" 'adresse mail de l'expéditeur n'est pas obligatoire
objmessage.To = "xxx@xxxx.fr" ' 'Email du destinataire doit-être correct ici
'objmessage.cc = Range("e4").Value ' ' email en copie
'objmessage.TextBody = "Bonjour," & vbCrLf & vbCrLf & "Voici une commande pharmacie pour le centre d'Ax" & vbCrLf & vbCrLf & "Bonne réception"
piece_jointe = ActiveWorkbook.Path & "\" & " " & "N° CAU " & Cells(3, 3).Value & ".pdf"
''piece_jointe = "C:\Documents and Settings\Les Lagouanère\Bureau\0917_001.pdf" 'chemin du fichier à envoyer en piéce-jointe
'piece_bis = "C:\Documents and Settings\Les Lagouanère\Bureau\Cligno.xls" ' Si on souhaite envoyer plusieurs pièces les déclarer
'messageHTML = "Ceci est un message en HTML envoyé automatiquement"


objmessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objmessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.sdis09.fr"
objmessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objmessage.Configuration.Fields.Update

objmessage.AddAttachment (piece_jointe) 'On ajoute la piéce jointe, il est possible d'envoyer plusieurs pièces
'objMessage.AddAttachment (piece_bis) 'dans ce cas on ajoute un objMessage.AddAttachement () par pièce
objmessage.Send

errorHandler:
'description de l'erreur survenue
MsgBox Err.Description
Range("a1").Select

End Sub

 

[Tail]

Re : envoie fichier joint en pdf

re bonjour,

j'ai modifié mon code mais j'ai une erreur "fichier spécifié introuvable" et je ne comprend pas pourquoi , j'ai cherché mais en vain
et pourtant le fichier est bien dans le répertoire.
voila le code et merci de votre aide

Sub envoie()
Dim objMessage As CDO.Message
Dim jobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
Dim extension As String
sNomPDF = " N° CAU " & Cells(3, 3)
sCheminPDF = "c:\docs communs\ops\archive rapports 2013\"
Dim messageHTML
On Error GoTo errorHandler

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Sortie de secours (Message Automatique)"
objMessage.From = "xxxxx@xxxxxx.fr" 'adresse mail de l'expéditeur n'est pas obligatoire
objMessage.To = "xxxxx@xxxxx.fr" 'Email du destinataire doit-être correct ici
objMessage.cc = "" 'Range("e4").Value ' email en copie
objMessage.TextBody = "Bonjour," & vbCrLf & vbCrLf & "Sortie de secours du centre d'Ax" & vbCrLf & vbCrLf & "Bonne réception"

piece_jointe = sCheminPDF & sNomPDF & ".pdf"
''piece_jointe = "C:\Documents and Settings\Les Lagouanère\Bureau\0917_001.pdf" 'chemin du fichier à envoyer en piéce-jointe
'piece_bis = "C:\Documents and Settings\Les Lagouanère\Bureau\Cligno.xls" ' Si on souhaite envoyer plusieurs pièces les déclarer
messageHTML = "Ceci est un message en HTML envoyé automatiquement"


objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.sdis09.fr"
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update

objMessage.AddAttachment piece_jointe 'On ajoute la piéce jointe, il est possible d'envoyer plusieurs pièces
'objMessage.AddAttachment (piece_bis) 'dans ce cas on ajoute un objMessage.AddAttachement () par pièce
objMessage.Send
MsgBox "Le mail à bien été envoyé !" ', 64, "Information"

'si erreur on sort de la procédure
Range("a1").Select
Application.DisplayAlerts = True
'Exit Sub

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



End Sub