Macro Insertion dernier fichier créé dans mail (nom en C12) Résolu/Fermé

Question

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!


Configuration: Windows 7 / Internet Explorer 9.0

cs_Le Pivert · Answer

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

caroline.bor · Answer

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

caroline.bor · Answer

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

cs_Le Pivert · Answer

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

cs_Le Pivert · Answer

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

caroline.bor · Answer

ça marche MERCIIIIIIIIIIIIIIIIII INFINIMENT !!!!

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

6 réponses

Discussions similaires