Gilles52300
XLDnaute Junior
bonjour Messieurs,
J'essaye de trouver une solution à mon souci, mais sans succès. je n'accède quasiment qu'à des discussions utilisant "Outlook"
J'utilise Mail comme messagerie par default.
J'ai trouvé ceci sur le net qui me permet de lancer et de préremplir un email mais je n'arrive pas à trouver comment faire pour insérer un fichier Pdf.
A la base ceci est pour envoyer le fichier actif, mais je ne sais pas comment faire pour le remplacer par mon pdf
La fonction qui lance le mail :
Si vous avez une piste, une idée, une solution... Merci d'avance.
Bonne journée.
J'essaye de trouver une solution à mon souci, mais sans succès. je n'accède quasiment qu'à des discussions utilisant "Outlook"
J'utilise Mail comme messagerie par default.
J'ai trouvé ceci sur le net qui me permet de lancer et de préremplir un email mais je n'arrive pas à trouver comment faire pour insérer un fichier Pdf.
Code:
'enregistrement dans le dossier
Fichier = Sheets("Feuil1").Range("P2") & Dte
ChDir Chemin
Chemin = Dir(Chemin) & Fichier & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "facture enregistrée dans le dossier " & Client & " sous le numéro " & Fichier
'Email
Dim wb As Workbook
Set wb = ActiveWorkbook
With wb
MailFromMacWithMail bodycontent:="Bonjour", _
mailsubject:=Fichier, _
toaddress:=Sheets("Feuil1").Range("J" & c), _
ccaddress:="", _
bccaddress:="", _
attachment:=Chemin, _
displaymail:=False
End With
Set wb = Nothing
A la base ceci est pour envoyer le fichier actif, mais je ne sais pas comment faire pour le remplacer par mon pdf
La fonction qui lance le mail :
Code:
Function MailFromMacWithMail(bodycontent As String, mailsubject As String, _
toaddress As String, ccaddress As String, bccaddress As String, _
attachment As String, displaymail As Boolean)
Dim scriptToRun As String
scriptToRun = scriptToRun & "tell application " & _
Chr(34) & "Mail" & Chr(34) & Chr(13)
scriptToRun = scriptToRun & _
"set NewMail to make new outgoing message with properties " & _
"{content:""" & bodycontent & """, subject:""" & _
mailsubject & """ , visible:true}" & Chr(13)
scriptToRun = scriptToRun & "tell NewMail" & Chr(13)
If toaddress <> "" Then scriptToRun = scriptToRun & _
"make new to recipient at end of to recipients with properties " & _
"{address:""" & toaddress & """}" & Chr(13)
If ccaddress <> "" Then scriptToRun = scriptToRun & _
"make new cc recipient at end of cc recipients with properties " & _
"{address:""" & ccaddress & """}" & Chr(13)
If bccaddress <> "" Then scriptToRun = scriptToRun & _
"make new bcc recipient at end of bcc recipients with properties " & _
"{address:""" & bccaddress & """}" & Chr(13)
If attachment <> "" Then
scriptToRun = scriptToRun & "tell content" & Chr(13)
scriptToRun = scriptToRun & "make new attachment with properties " & _
"{file name:""" & attachment & """ as alias} " & _
"at after the last paragraph" & Chr(13)
scriptToRun = scriptToRun & "end tell" & Chr(13)
End If
If displaymail = False Then scriptToRun = scriptToRun & "send" & Chr(13)
scriptToRun = scriptToRun & "end tell" & Chr(13)
scriptToRun = scriptToRun & "end tell"
If Len(toaddress) + Len(ccaddress) + Len(bccaddress) = 0 Or mailsubject = "" Then
MsgBox "There is no To, CC or BCC address or Subject for this mail"
Exit Function
Else
On Error Resume Next
MacScript (scriptToRun)
On Error GoTo 0
End If
End Function
Si vous avez une piste, une idée, une solution... Merci d'avance.
Bonne journée.
Dernière édition: