[VBA] aide pour récupération du chemin d'un ficher avant envoi de mail

Le 13/02/2023 à 14:01

Bonjour à tous,

En m'appuyant sur le très bon tuto de BrunoM45 j'ai réussi à insérer son code pour dans un premier temps générer un pdf à partir d'une feuille de classeur , et l'envoyer par mail.

Aujourd'hui je souhaiterais le modifier pour que d'une part je puisse choisir le répertoire d'enregistrement, demander une confirmation avant envoi (si oui j'envoie si non je sors du sub) puis l'envoyer. Mais cette dernière étape me pose un souci

je n'arrive pas à récupérer l'emplacement du fichier enregistré.

Sub Sheet_ToPDF_ToMail()
  ' Déclaration des variables utilisées dans le code de brunoM45
  Dim sPath As String, sFileName As String, ShtName As String 'variable du code de BrunoM45
  Dim OutApp As Object, OutMail As Object 'variable du code de BrunoM45
  '

  ' Nom du fichier à envoyer par mail
  sFileName = Format(Now(), "DD-MMM-YYYY hh mm AMPM") & " - Ajout de bulles techniques dans l'IPAM.pdf"
  ' Vérifier l'extension du fichier à enregistrer
  If Right(sFileName, 4) <> ".pdf" Then sFileName = sFileName & ".pdf"

  ' 1) Générer le PDF dans le répertoir temporaire de l'utilisateur

'ici j'enregistre bien le fichier où je le souhaite
 Dim FName As Variant
    FName = Application.GetSaveAsFilename( _
        initialfilename:="%USERPROFILE%" & "\Documents\ " & sFileName, _
        FileFilter:="PDF files, *.pdf", _
        Title:="Enregistrement du fichier")

' ici j'ai la msgbox de confirmation avant envoi
Dim ouinon As Integer
ouinon = MsgBox("En continuant, le fichier d'ajout de bulles dans l'IPAM (" & sFileName & ") sera envoyé automatiquement à l'équipe IPAM. Voulez-vous continuer?", vbOKCancel, "Choix")
If ouinon = 2 Then Exit Sub

  ' 2) Créer le mail et joindre le fichier
  ' Création d'une instance Outlook pour envoyer un mail
  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(olMailItem)
  ' Avec mon objet OutMail
  With OutMail
    .Display  ' Afficher le mail pour afficher la signature
    ' Destinataire(s) du mail

    '########Destinataire du fichier###########

    .To = "XXXXXX"
    ' Copie du mail
    .CC = "XXXXX"
    ' Sujet de l'OutMail
    .Subject = "[BIPLAN] Ajout de bulles techniques dans IPAM"
    ' Corps du mail avec signature à la fin
    .HTMLBody = "Bonjour," & "<BR><BR>" _
    & "Vous trouverez ci-joint le fichier " & sFileName & "<BR><BR>" & "Merci de bien vouloir créer les bulles du fichier dans l'IPAM" & "<BR><BR>" & "Cordialement" & "<BR><BR>" & .HTMLBody

' et la se trouve mon problème, je retranscris ici le code initial de BRunoM45, car malgré plusieurs essais je n'ai pas réussi à trouver le bon code
    ' Joindre le fichier précédemment créé
    .Attachments.Add sPath & sFileName

    ' Envoyer l'OutMail
    .Send
  End With
  ' Effacer les variable objet
  Set OutMail = Nothing: Set OutApp = Nothing
  ' Supprimer le fichier du répertoire temporaire
  'Kill sPath & sFileName
End Sub

Si qqn peut m'éclairer...Merci

Le 13/02/2023 à 19:48

Bonsoir Sitting_bull et merci

Quand est créé le fichier dont tu donnes le nom dans la procédure pour moi il manque un export PDF

Ensuite, comme tu choisi l'emplacement et le nom dans la variable "Fname" c'est celle-ci qu'il faut utiliser

 .Attachments.Add Fname

D'ailleurs je ne la déclarerai pas en Variant mais en String

A+

Le 14/02/2023 à 09:05

Bonjour

alors effectivement mon export ne se fait pas au travers de ces lignes comme je l'imaginais.

FName = Application.GetSaveAsFilename( _
        initialfilename:="%USERPROFILE%" & "\Documents\ " & sFileName, _
        FileFilter:="PDF files, *.pdf", _
        Title:="Enregistrement du fichier")

Le process est dans mon esprit découpé comme suit:

  • création fichier PDF
  • confirmation d'envoi
  • si oui j'envoie, si non la procédure s'arrête

Ce que je voulais c'était adapté ton code pour pouvoir choisir l'emplacement du fichier

Le 14/02/2023 à 09:49

Bonjour,

Alors, il faut le faire ainsi

Sub Sheet_ToPDF_ToMail()
  ' Déclaration des variables
  Dim sPathFile As String, sFileName As String
  Dim OutApp As Object, OutMail As Object
  ' Nom du fichier à envoyer par mail
  sFileName = Format(Now(), "DD-MMM-YYYY hh mm AMPM") & " - Ajout de bulles techniques dans l'IPAM.pdf"
  ' Vérifier l'extension du fichier à enregistrer
  If Right(sFileName, 4) <> ".pdf" Then sFileName = sFileName & ".pdf"

  ' 1) Demander le nom et l'endroit de l'enregistrement
  sPathFile = Application.GetSaveAsFilename(InitialFileName:="%USERPROFILE%" & "\Documents\ " & sFileName, _
          FileFilter:="PDF files, *.pdf", Title:="Enregistrement du fichier")
  ' 2) Export de la feuille nommée au format PDF du classeur contenant cette macro
  ThisWorkbook.Sheets("Feuil1ToPDF").ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPathFile, _
      Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

  ' ici j'ai la msgbox de confirmation avant envoi
  If MsgBox("En continuant, le fichier d'ajout de bulles dans l'IPAM (" & sFileName & ")" _
    & "sera envoyé automatiquement à l'équipe IPAM. Voulez-vous continuer?", vbQuestion + vbYesNo, "Choix") = vbNo Then Exit Sub

  ' 2) Créer le mail et joindre le fichier
  ' Création d'une instance Outlook pour envoyer un mail
  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)  ' olMailItem = 0
  ' Avec mon objet OutMail
  With OutMail
      .Display                                  ' Afficher le mail pour afficher la signature
      ' Destinataire(s) du mail
      .To = "XXXXXX"
      ' Copie du mail
      .CC = "XXXXX"
      ' Sujet de l'OutMail
      .Subject = "[BIPLAN] Ajout de bulles techniques dans IPAM"
      ' Corps du mail avec signature à la fin
      .HTMLBody = "Bonjour," & "<BR><BR>" _
                & "Vous trouverez ci-joint le fichier " & sFileName & "<BR><BR>" _
                & "Merci de bien vouloir créer les bulles du fichier dans l'IPAM" & "<BR><BR>" & "Cordialement" & "<BR><BR>" & .HTMLBody
      ' Joindre le fichier précédemment créé
      .Attachments.Add sPathFile
      ' Envoyer l'OutMail
      .Send
  End With
  ' Effacer les variable objet
  Set OutMail = Nothing: Set OutApp = Nothing
End Sub

Nota : attention je ne teste pas si le nom de fichier existe toujours après le choix par l'utilisateur

A+

Le 14/02/2023 à 10:16

Super!!!

Cela fonctionne comme souhaité. Merci

Rechercher des sujets similaires à "vba aide recuperation chemin ficher envoi mail"