Macro Insertion dernier fichier créé dans mail (nom en C12)

Résolu
caroline.bor Messages postés 23 Date d'inscription   Statut Membre Dernière intervention   -  
caroline.bor Messages postés 23 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

Je souhaiterai grace à une macro joindre le dernier fichier créé dans mon mail.
la création du mail marche tres bien, j'ai juste un souci concernant l'ajout de la pj, car il faudrait qu'elle choisisse le nom de fichier indiqué en cellule C12
Pouvez vous m'aider svp? voici l'extrait de macro en question:

Quelques précisions:
en C12 j'ai une liste déroulante avec le nom du fichier qui est au préalable enregistré dans le dossier
Message d'erreur: fichier introuvable, vérifiez le chemin d'acces

Sub email()
[...]
Dim AdresseRépertoire As Variant
Dim vNomFichier As String
AdresseRépertoire = ActiveWorkbook.Path
vNomFichier = ActiveSheet.Range("C12").Value
[...]

With outlookMessage
.Subject = vObjet
.Recipients.Add vAdresse
.Body = vMessage
.OriginatorDeliveryReportRequested = False
.ReadReceiptRequested = False
.Display
.Attachments.Add AdresseRépertoire & "\" & vNomFichier 'pour inserer fichier

End Sub

J'espère que je suis assez claire !!

Merci d'avance pour votre grande aide!

6 réponses

  1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Bonjour,

    Voici le code à adapter l'extension:

    'Allez dans Outils- Référence et cochez Microsoft Outlook 12.0 Object Library
    Sub email()
     Dim appOutlook As Outlook.Application
     Dim message As Outlook.mailitem
    Dim AdresseRépertoire As Variant
    Dim Adresse As String
    Dim vNomFichier As String
    AdresseRépertoire = ActiveWorkbook.Path
    vNomFichier = ActiveSheet.Range("C12").Value
    
     'Lance une session OutLook
     Set appOutlook = CreateObject("outlook.Application")
      'Demande de l'adresse email du destinataire
     Adresse = InputBox("Entrez une adresse Email ?", "Envoyer un Email")
     If Adresse = "" Then Exit Sub
     'Crée un nouveau message
     Set message = appOutlook.createitem(olMailItem)
     With message 'paramétrons le message
     .Subject = "ENVOYER UN MAIL A PARTIR D'EXCEL"
    'Paramétrage du champ Objet :
      .Body = "Ceci est le corps du message" & Chr(13) & "Cordialement" & Chr(13) & "Le Pivert"
      'Paramétrage du corps du texte contenu et signature
      .BodyFormat = olFormatHTML
      'Choix du format du message ici html
      .Recipients.Add (Adresse)
    .OriginatorDeliveryReportRequested = False
    .ReadReceiptRequested = False
    .Display
    .Attachments.Add AdresseRépertoire & "" & vNomFichier & ".xlt" 'pour inserer fichier adapter extension
    'MsgBox "Envoyé"' activer pour tester
    .send
    End With
    MsgBox " Message Envoyé"
    End Sub
    

    0
  2. caroline.bor Messages postés 23 Date d'inscription   Statut Membre Dernière intervention  
     
    Bonjour Le Pivert !! Merci pour ta reactivité c'est vraiment cool!

    Alors en fait j'avais deja ecrit la macro pour le mail (et ça marche)
    donc j'ai juste adapté au niveau de l'ajout du fichier, et j'ai toujours le message d'erreur "fichier introuvable, verifiez le chemin d'acces

    As tu une idée??

    Merciiii!!

    Sub email()

    '-------Contrôler dans Bisual Basic/Outils/Références/que Microsoft Outlook --,- Object Librairy est bien coché
    Dim outlookDossier As Outlook.MAPIFolder
    Dim outlookMessage As Outlook.MailItem
    Dim vAdresse As String
    Dim vObjet As String
    Dim vMessage As String
    Dim vCellule As Object
    Dim AdresseRépertoire As Variant
    Dim vNomFichier As String
    AdresseRépertoire = ActiveWorkbook.Path
    vNomFichier = ActiveSheet.Range("C12").Value

    '---------------------copie de l'onglet et enregitrement ds repertoire
    Application.DisplayAlerts = False
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs AdresseRépertoire & "\" & vNomFichier
    ActiveWorkbook.Close

    Range("P18").Select 'adresse mail
    'Do While ActiveCell <> ""
    vMessage = ""
    For Each vCellule In Range("R18:R33") 'corps message
    vMessage = vMessage & vCellule & Chr(10)
    Next
    'vAdresse = ActiveCell
    vAdresse = ActiveSheet.Range("P18").Value
    vObjet = ActiveSheet.Range("Q18").Value
    AdresseFichier = ActiveSheet.Range("B2").Value

    Set outlookDossier = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set outlookMessage = outlookDossier.Items.Add
    vMessage = Join(Application.Transpose(ActiveSheet.Range("R18:R41").Value), vbLf)

    'PROBLEME A PARTIR DE ATTACHMENTS-->" fichier introuvable"
    With outlookMessage
    .Subject = vObjet
    .Recipients.Add vAdresse
    .Body = vMessage
    .OriginatorDeliveryReportRequested = False
    .ReadReceiptRequested = False
    .Attachments.Add AdresseRépertoire & "" & vNomFichier & ".xlsx" 'pour inserer fichier
    .Display

    End With
    ActiveCell.Offset(1, 0).Select
    'Loop

    End Sub
    0
  3. caroline.bor Messages postés 23 Date d'inscription   Statut Membre Dernière intervention  
     
    une autre alternative serait d'inserer le dernier fichier créé dans le repertoire?... je ne sais pas trop si c'est possible?

    ou d'aller chercher la cellule B2 (qui est une fonction concatener et qui correspond a l'adresse du fichier:
    X:\TP\BEBF\BRUS\$DATA\DPT-ACCOUNTING\CONSO-Magnitude\3 Folders personnels\Caroline\MACROS\RETRAITES\Bostik Inc
    0
  4. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Il faut que tu saches que:

    ActiveWorkbook.Path

    est le chemin du dossier où se trouve ton classeur. Pour que cela fonctionne, il faut que la pièce jointe (fichier) soit dans ce même dossier!

    ActiveWorkbook.Save As AdresseRépertoire & "\" & vNomFichier & ".xlsx"

    enregistre dans le même dossier que ton classeur. Il ne faut pas oublié l'extension
    0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Je viens de m'apercevoir que cette ligne était fausse:

    .Attachments.Add AdresseRépertoire & "" & vNomFichier & ".xlt" 'pour inserer fichier adapter extension


    C'est le site qui a oublié un antislash; Il faut mettre

    .Attachments.Add AdresseRépertoire & "\" & vNomFichier & ".xlt" 'pour inserer fichier adapter extension

    0
  7. caroline.bor Messages postés 23 Date d'inscription   Statut Membre Dernière intervention  
     
    ça marche MERCIIIIIIIIIIIIIIIIII INFINIMENT !!!!
    0