Envoi feuille en format PDF par email

Bonjour à tous

Je sais que ce thème a été traité à maintes reprises, mais je n'ai pas trouvé la solution à mon problème

Je souhaite pouvoir envoyer ma page "Formular" en PDF par email.

J'ai mes références, mes textes, mes correspondances, mon corps de texte.

Dans ma macro ci-dessous, (qui fonctionne) le fichier s'enregistre sur le réseau.

Je souhaite créer une macro similaire. Mais l'utilisateur ne sera pas connecté sur le réseau.

Je souhaite également éviter que le fichier PDF créer s'enregistre sur C: ou son bureau...

1) Existe-t-il de moyen de créer un fichier temporaire et de l'effacer en fin de procédure ?

2) Enfin, existe-t-il le moyen de vérifier si l'utilisateur dispose d'Outlook, auquel cas, le fichier PDF doit se créer et un message d'avertissement doit informer l'utilisateur que le fichier est sur son bureau.

Une solution - si vous pouvez m'aider est prioritaire au point 1)

Ma macro:

Sub Envoi_PDF()

Application.ScreenUpdating = False

Sheets("Formular").Select

ActiveSheet.PageSetup.PrintArea = "F8:AA70"

Dim olApp As Outlook.Application

Dim olMail As MailItem

Dim CurFile As String

Set olApp = New Outlook.Application

Set olMail = olApp.CreateItem(olMailItem)

Dim Path As String, Nom As String

Sheets("Settings").Select

File = Range("E5")

Datum = Format(Range("F5"), "yyyymmdd hh.mm")

Sheets("Formular").Select

CurFile = "\\IFC1.IFR.INTRA2.ADMIN.CH\Shares\Organisation\RECEPTION PDF\" & File & " - " & Datum & ".pdf"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=CurFile, _

Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _

OpenAfterPublish:=False

With olMail

.To = Sheets("Settings").Range("G5").Value

.Subject = Sheets("Settings").Range("H5").Value

.Body = Sheets("Settings").Range("I5").Value

.Attachments.Add CurFile

.Display '.Send

ActiveSheet.PageSetup.PrintArea = ""

End With

'ActiveSheet.Protect "XXX.XXX"

Range("A1").Select

Sheets("FORMULAR").Select

Range("A1").Select

ActiveSheet.PageSetup.PrintArea = ""

Sheets("FORMULAR").Select

Application.ScreenUpdating = True

End Sub

Une modification possible avec mes codes "CurFile" ?

D'avance merci !

Cordialement

Willau

Bonjour,

Willau a écrit :

Je souhaite également éviter que le fichier PDF créer s'enregistre sur C: ou son bureau...

1) Existe-t-il de moyen de créer un fichier temporaire et de l'effacer en fin de procédure ?

Enregistre le dans le dossier temp et supprime le en fin de procédure

    nompdf = Environ("Temp") & "\" & "monfichier"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    Set messagerie = CreateObject("Outlook.Application")
    Set email = messagerie.CreateItem(0)
    With email
        .to = [destinataire]
        .Subject = [titre]
        .body = "Veuillez trouver en pièce jointe ..."
        .ReadReceiptRequested = True
        .Attachments.Add nompdf & ".pdf"
        .display
    End With
    Set email = Nothing
    Set messagerie = Nothing

    Kill Environ("Temp") & "\" & "monfichier" & ".pdf"

Willau a écrit :

Je souhaite également éviter que le fichier PDF créer s'enregistre sur ... son bureau...

... un message d'avertissement doit informer l'utilisateur que le fichier est sur son bureau.

Il n'y a pas une sorte d'incompatibilité dans ton sujet ?

Pour tester la présence d'outlook :

Sub test_outlook()
Dim messagerie As Object
On Error GoTo err_handler
Set messagerie = CreateObject("Outlook.Application")
err_handler:
    MsgBox "L'application Outlook est absente de ce poste de travail !"
End Sub

Bonjour,

Salut Steelson.

ci-dessous ton code remanié avec les mêmes éléments que la réponse de Steelson

Sub Envoi_PDF()
    Dim olApp As Object, olMail As Object
    Dim file As String, CurFile As String, datum As String

    On Error Resume Next
    'Assignation de l'application Outlook et de l'objet olMail
    Set olApp = CreateObject("outlook.application")
    If Err.Number <> 0 Then MsgBox "erreur : application Outlook non disponible": Exit Sub
    Set olMail = olApp.CreateItem(0)

    'remplissage du message
    With Sheets("Settings")
        olMail.to = .Range("G5").Value
        olMail.Subject = .Range("H5").Value
        olMail.Body = .Range("I5").Value
        file = .Range("E5")
        datum = Format(.Range("F5"), "yyyymmdd hh.mm")
        CurFile = Environ("tmp") & "\" & file & " - " & datum & ".pdf"
        Sheets("Formular").ExportAsFixedFormat Type:=xlTypePDF, Filename:=CurFile, OpenAfterPublish:=False
        olMail.Attachments.Add CurFile
    End With

    '....... envoie le message
    olMail.Send
    Kill CurFile
    If Err.Number <> 0 Then MsgBox "erreur : " & Err.Description & "  destinataire = " & olMail.to: Exit Sub

    'Désassignation objets
     Set olApp = Nothing
     Set olMail = Nothing

End Sub