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

Résolu/Fermé
caroline.bor
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015
- Modifié par caroline.bor le 3/09/2014 à 14:34
caroline.bor
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015
- 4 sept. 2014 à 10:45
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

cs_Le Pivert
Messages postés
7745
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
20 mai 2022
709
3 sept. 2014 à 16:08
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
caroline.bor
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015

3 sept. 2014 à 16:32
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
caroline.bor
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015

Modifié par caroline.bor le 3/09/2014 à 16:45
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
cs_Le Pivert
Messages postés
7745
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
20 mai 2022
709
3 sept. 2014 à 18:01
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

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
cs_Le Pivert
Messages postés
7745
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
20 mai 2022
709
3 sept. 2014 à 18:23
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
caroline.bor
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015

4 sept. 2014 à 10:45
ça marche MERCIIIIIIIIIIIIIIIIII INFINIMENT !!!!
0