A voir également:
- Excel macro mail automatique
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Yahoo mail - Accueil - Mail
- Liste déroulante excel - Guide
- Si et excel - Guide
- Aller à la ligne excel - Guide
6 réponses
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
Modifié par lermite222 le 13/08/2010 à 10:41
Modifié par lermite222 le 13/08/2010 à 10:41
Bonjour,
Si j'ai bien compris...
A+
L'expérience instruit plus sûrement que le conseil. (André Gide)
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
Si j'ai bien compris...
Sub Envoi() Dim Sujet As String, Corps As String, Desti As String Dim CC As String, c As Range, PJ As String, Num As Integer If Application.Workbooks.Count > 1 Then 'au moins deux classeurs ouvert Sujet = "multi envoie" Corps = "test à envoie de multi destinnataire" CC = "" Desti = "x@x;x@x" 'prend le path et nom de l'autre classeur If Workbooks(1).Name = ThisWorkbook.Name Then Num = 2 Else Num = 1 PJ = Workbooks(Num).Path & "\" & Workbooks(Num).Name SendNotesMail Sujet, Corps, Desti, CC, PJ Else MsgBox "pas de classeur disponnible" End If End Sub
A+
L'expérience instruit plus sûrement que le conseil. (André Gide)
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
13 août 2010 à 10:44
13 août 2010 à 10:44
Er éventuellement si tu a ouvert plusieurs classeurs et que tu veux tous les envoyer d'un coup...
Sub EnvoiMulti() Dim Sujet As String, Corps As String, Desti As String Dim CC As String, c As Range, PJ As String, Num As Integer Dim Wk As Workbook If Application.Workbooks.Count > 1 Then 'au moins deux classeurs ouvert Sujet = "multi envoie" Corps = "test à envoie de multi destinnataire" CC = "" Desti = "x@x;x@x" 'Envoi automatique de plusieurs classeurs For Each Wk In Workbooks If Wk.Name <> ThisWorkbook.Name Then PJ = Wk.Path & "\" & Wk.Name SendNotesMail Sujet, Corps, Desti, CC, PJ End If Next Wk Else MsgBox "pas de classeur disponnible" End If End Sub
Polux31
Messages postés
6917
Date d'inscription
mardi 25 septembre 2007
Statut
Membre
Dernière intervention
1 novembre 2016
1 204
12 août 2010 à 15:22
12 août 2010 à 15:22
Bonjour,
Désolé mais je n'ai pas compris.
Mais au cas où !!!
PJ = ThisWorkbook.Path & "\" & ThisWorkbook.Name
Ôo
Désolé mais je n'ai pas compris.
Mais au cas où !!!
PJ = ThisWorkbook.Path & "\" & ThisWorkbook.Name
Ôo
Non cela ne fonctionne pas.
Pour simplifier, j'ai mon fichier excel et je lance une macro sur ce fichier, pour l'envoyer en automatique à des adresse mail(sans passer par ma boite mail).
tout est bon pour le moment !
Seulement quand j'ouvre un autre fichier excel, et que je lance la macro, là elle m'envoie le 1 fichier excel vu que je l'ai enregistrer à cette ligne là :
Qui vas donc rechercher le fichier à envoyer. Et moi ce que je souhaite, c'est lorsque j'ouvre un fichier excel, et quand je lance la macro, que se soit CE fichier excel qui s'envoie (que je n'ai pas a modifier le code de la macro a chaque fichier différents !).
Pour simplifier, j'ai mon fichier excel et je lance une macro sur ce fichier, pour l'envoyer en automatique à des adresse mail(sans passer par ma boite mail).
tout est bon pour le moment !
Seulement quand j'ouvre un autre fichier excel, et que je lance la macro, là elle m'envoie le 1 fichier excel vu que je l'ai enregistrer à cette ligne là :
PJ = "D:\documents and Settings\lol\Desktop\nom_du_fichier_excel.xls"
Qui vas donc rechercher le fichier à envoyer. Et moi ce que je souhaite, c'est lorsque j'ouvre un fichier excel, et quand je lance la macro, que se soit CE fichier excel qui s'envoie (que je n'ai pas a modifier le code de la macro a chaque fichier différents !).
Polux31
Messages postés
6917
Date d'inscription
mardi 25 septembre 2007
Statut
Membre
Dernière intervention
1 novembre 2016
1 204
12 août 2010 à 19:57
12 août 2010 à 19:57
Tu veux dire que tu as cette macro dans tous les fichiers Excel ???
Elle est enregistrée où cette macro ???
Elle est enregistrée où cette macro ???
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Polux31
Messages postés
6917
Date d'inscription
mardi 25 septembre 2007
Statut
Membre
Dernière intervention
1 novembre 2016
1 204
13 août 2010 à 11:34
13 août 2010 à 11:34
Bonjour Zlatan, bonjour lermite
Je crois comprendre que les macros sont enregistrées dans des classeurs sauvegardés dans un répertoire.
Si c'est le cas, il faut passer le nom du fichier en paramètre dans la procédure Envoi:
Et dans le classeur qui appelle la macro:
:o)
Je crois comprendre que les macros sont enregistrées dans des classeurs sauvegardés dans un répertoire.
Si c'est le cas, il faut passer le nom du fichier en paramètre dans la procédure Envoi:
Sub Envoi(ByVal PJ As String) Dim Sujet As String, Corps As String, Desti As String Dim CC As String, c As Range Sujet = "multi envoie" Corps = "test à envoie de multi destinnataire" CC = "" Desti = "x@x;x@x" SendNotesMail Sujet, Corps, Desti, CC, PJ End Sub
Et dans le classeur qui appelle la macro:
Sub EnvoiMail() Dim PJ As String PJ = ThisWorkBook.Path & "\" & ThisWorkBook.Name 'Remplacer "C:\Temp\data\monClasseurMacro.xls!Envoi" par le chemin complet et le nom du classeur contenant la macro. Application.Run("C:\Temp\data\monClasseurMacro.xls!Envoi", PJ) End Sub
:o)
Bonjour, Polux31,lermite222,
merci pour vos aide, alors pour lermite222, ce code m'a l'air for intéressant, je viens de l'essayer, au niveau du code tout est bon, mais cela fais 10 minute, et je n'ai pas reçu le mail avec le fichier excel (peut-être est-ce trop long Oo).
Pour polux31, cela ne fonctionne pas quand je tente de l'insérer, mais cela ne fonctionne pas.
merci pour vos aide, alors pour lermite222, ce code m'a l'air for intéressant, je viens de l'essayer, au niveau du code tout est bon, mais cela fais 10 minute, et je n'ai pas reçu le mail avec le fichier excel (peut-être est-ce trop long Oo).
Pour polux31, cela ne fonctionne pas quand je tente de l'insérer, mais cela ne fonctionne pas.
Voiçi mon code pour le moment :
Sub Envoi()
Dim Sujet As String, Corps As String, Desti As String
Dim CC As String, c As Range, PJ As String, Num As Integer
If Application.Workbooks.Count > 1 Then
'au moins deux classeurs ouvert
Sujet = "dernier test"
Corps = "envoie final à plusieurs personnes"
CC = ""
Desti = "xx@xx"
'prend le path et nom de l'autre classeur
If Workbooks(1).Name = ThisWorkbook.Name Then Num = 2 Else Num = 1
PJ = Workbooks(Num).Path & "\" & Workbooks(Num).Name
SendNotesMail Sujet, Corps, Desti, CC, PJ
Else
MsgBox "pas de classeur disponnible"
End If
End Sub
Public Sub SendNotesMail(Sujet, Corps, Desti, CC, PJ)
'Set up the objects required for Automation into lotus notes
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim Corps_Msg As String ' text du courriel
Dim MailDbName As String 'THe current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
'Next line only works with 5.x and above. Replace password with your
' Session.Initialize ("password" )
'Get the sessions username and then calculate the mail file name
'You may or may not need this as for MailDBname with some systems you
'can pass an empty string or using above password you can use other
''MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) -
''UserName = Session.UserName
''SearchString = Recipient
''SearchChar = "@"
''MyPos = InStr(1, SearchString, SearchChar, vbTextCompare)
''Destinataire = Left(SearchString, MyPos - 1)
'Open the mail database in notes
Set Maildb = Session.GETDATABASE("", "")
If Maildb.IsOpen = True Then
'Already open for mail
Else
Maildb.OPENMAIL
End If
'Set up the new mail document
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.sendto = Desti
MailDoc.Subject = Sujet
MailDoc.copyto = CC
'MailDoc.Body = Corps
Set MailCorps = MailDoc.CREATERICHTEXTITEM("Body")
With MailCorps
.ADDNEWLINE 1
.APPENDTEXT Corps
.ADDNEWLINE 2
End With
MailDoc.SAVEMESSAGEONSEND = True
'Set up the embedded object and attachment and attach it
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
'AttachME.AppendText "toto"
Call AttachME.EMBEDOBJECT(1454, "", PJ, "Attachment")
'Send the document
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items
MailDoc.Send 0
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Sub
En gros, cela fonctionne lorsque l'envoie à un seul destinataire, mais lorsque j'en envoie à un autre + moi même cela ne fonctionne pas. (je n'ai pas encore test à envoyer que à plusieurs personnes excepté moi).
Sub Envoi()
Dim Sujet As String, Corps As String, Desti As String
Dim CC As String, c As Range, PJ As String, Num As Integer
If Application.Workbooks.Count > 1 Then
'au moins deux classeurs ouvert
Sujet = "dernier test"
Corps = "envoie final à plusieurs personnes"
CC = ""
Desti = "xx@xx"
'prend le path et nom de l'autre classeur
If Workbooks(1).Name = ThisWorkbook.Name Then Num = 2 Else Num = 1
PJ = Workbooks(Num).Path & "\" & Workbooks(Num).Name
SendNotesMail Sujet, Corps, Desti, CC, PJ
Else
MsgBox "pas de classeur disponnible"
End If
End Sub
Public Sub SendNotesMail(Sujet, Corps, Desti, CC, PJ)
'Set up the objects required for Automation into lotus notes
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim Corps_Msg As String ' text du courriel
Dim MailDbName As String 'THe current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
'Next line only works with 5.x and above. Replace password with your
' Session.Initialize ("password" )
'Get the sessions username and then calculate the mail file name
'You may or may not need this as for MailDBname with some systems you
'can pass an empty string or using above password you can use other
''MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) -
''UserName = Session.UserName
''SearchString = Recipient
''SearchChar = "@"
''MyPos = InStr(1, SearchString, SearchChar, vbTextCompare)
''Destinataire = Left(SearchString, MyPos - 1)
'Open the mail database in notes
Set Maildb = Session.GETDATABASE("", "")
If Maildb.IsOpen = True Then
'Already open for mail
Else
Maildb.OPENMAIL
End If
'Set up the new mail document
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.sendto = Desti
MailDoc.Subject = Sujet
MailDoc.copyto = CC
'MailDoc.Body = Corps
Set MailCorps = MailDoc.CREATERICHTEXTITEM("Body")
With MailCorps
.ADDNEWLINE 1
.APPENDTEXT Corps
.ADDNEWLINE 2
End With
MailDoc.SAVEMESSAGEONSEND = True
'Set up the embedded object and attachment and attach it
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
'AttachME.AppendText "toto"
Call AttachME.EMBEDOBJECT(1454, "", PJ, "Attachment")
'Send the document
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items
MailDoc.Send 0
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Sub
En gros, cela fonctionne lorsque l'envoie à un seul destinataire, mais lorsque j'en envoie à un autre + moi même cela ne fonctionne pas. (je n'ai pas encore test à envoyer que à plusieurs personnes excepté moi).