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
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 voir également:
- Macro Insertion dernier fichier créé dans mail (nom en C12)
- Fichier rar - Guide
- Fichier host - Guide
- Fichier iso - Guide
- Yahoo mail - Guide
- Comment réduire la taille d'un fichier - Guide
6 réponses
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
728
3 sept. 2014 à 16:08
3 sept. 2014 à 16:08
Bonjour,
Voici le code à adapter l'extension:
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
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015
3 sept. 2014 à 16:32
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
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
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
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
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
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
728
3 sept. 2014 à 18:01
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
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
728
3 sept. 2014 à 18:23
3 sept. 2014 à 18:23
Je viens de m'apercevoir que cette ligne était fausse:
C'est le site qui a oublié un antislash; Il faut mettre
.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
Messages postés
23
Date d'inscription
mercredi 30 juillet 2014
Statut
Membre
Dernière intervention
12 novembre 2015
4 sept. 2014 à 10:45
4 sept. 2014 à 10:45
ça marche MERCIIIIIIIIIIIIIIIIII INFINIMENT !!!!
