-----Message d'origine-----
Salut André,
Nomme tes 2 plages d'adresses:
Adresses_à
Adresses_cc
Supprime les 2 lignes:
For Each Cell In Range("Adresses")
Next Cell
Remplace les lignes:
EMailSendTo = Cell.Value ' Required - Send to address
' Cas avec une seule adresse
'EMailSendTo = "" '
Required - Send to address
EMailCCTo = "" '' Optional
par ce bout de code:
(Je crois me souvenir que le séparateur
d'adresse de LotusNote est le ";"
sinon adapte)
'*************************
sep = ";"
For Each Cell In Range("Adresses_à")
x_à = x_à & sep & Cell.Value
Next
deb1:
If Right(x_à, 1) = sep Then x_à = _
Left(x_à, Len(x_à) - 1): GoTo deb1
deb2:
If Left(x_à, 1) = sep Then x_à = _
Right(x_à, Len(x_à) - 1): GoTo deb2
EMailSendTo = x_à
For Each Cell In Range("Adresses_cc")
x_cc = x_cc & sep & Cell.Value
Next
deb1:
If Right(x_cc, 1) = sep Then x_cc = _
Left(x_cc, Len(x_cc) - 1): GoTo deb1
deb2:
If Left(x_cc, 1) = sep Then x_cc = _
Right(x_cc, Len(x_cc) - 1): GoTo deb2
EMailCCTo = x_cc
'************************************
Cela devrait faire..................
--
Amicalement
Jean-François Aubert
{Vaudois de la Côte Lémanique}
"André" a écrit
dans le message de
news:ff6d01c3f237$1a023060$
Dans l'excellent site EXCELLABO j'ai trouvé le code ci-
dessous pour envoyer un courrier (multi diffusion) avec
pièce jointe automatiquement par Lotus notes.
Avec ce code il y a autant de courrier expédié qu'il y a
de destinataires (soit 10 courriers pour 10
destinataires).
Comment peut-on aménager ce code pour adresser un seul
courrier à plusieurs personnes destinataires et en copie?
(1 courrier, 10 destinataires et 5 copies)
Merci de votre réponse
Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object
Function SendMail()
'mpep, auteur inconnu
On Error GoTo SendMailError
' Plage d'adresses e-mail dans une feuille de calcul
For Each Cell In Range("Adresses")
' Cas avec la plage
EMailSendTo = Cell.Value ' Required - Send to
address
' Cas avec une seule adresse
'EMailSendTo = "" '
Required - Send to address
EMailCCTo = "" '' Optional
EMailBCCTo = "" '' Optional
EmailSubject = "Envoi d'un document joint" '
Optional
''Establish Connection to Notes
Set objNotesSession = CreateObject
("Notes.NotesSession")
''Establish Connection to Mail File
'' .GETDATABASE
("SERVER", "FILE")
Set objNotesMailFile =
objNotesSession.GETDATABASE
("", "")
''Open Mail
objNotesMailFile.OPENMAIL
''Create New Memo
Set objNotesDocument =
objNotesMailFile.CREATEDOCUMENT
''Create 'Subject Field'
Set objNotesField =
objNotesDocument.APPENDITEMVALUE("Subject", EmailSubject)
''Create 'Send To' Field
Set objNotesField =
objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)
''Create 'Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("CopyTo",
EMailCCTo)
''Create 'Blind Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("BlindCopyTo",
EMailBCCTo)
''Create 'Body' of memo
Set objNotesField =
objNotesDocument.CREATERICHTEXTITEM("Body")
With objNotesField
.APPENDTEXT "Cet e-mail a été généré par un
processus automatique."
.ADDNEWLINE 1
.APPENDTEXT "This e-mail is generated by an
automated process."
'.APPENDTEXT "Please follow established
contact " & _
"procedures should you have any
questions."
.ADDNEWLINE 2
.APPENDTEXT "Cordialement"
.ADDNEWLINE 1
.APPENDTEXT "Eric RENAUD"
End With
''Attach the file --1454 indicate a file
attachment
objNotesField = _
objNotesField.EMBEDOBJECT(1454, "",
ActiveWorkbook.FullName)
''Send the e-mail
objNotesDocument.SEND (0)
Next Cell
''Release storage
Set objNotesSession = Nothing
Set bjNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing
''Set return code
SendMail = True
Exit Function
SendMailError:
Msg = "Error # " & Str(Err.Number) & " was generated
by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
SendMail = False
End Function
'Eric Renaud
.
-----Message d'origine-----
Salut André,
Nomme tes 2 plages d'adresses:
Adresses_à
Adresses_cc
Supprime les 2 lignes:
For Each Cell In Range("Adresses")
Next Cell
Remplace les lignes:
EMailSendTo = Cell.Value ' Required - Send to address
' Cas avec une seule adresse
'EMailSendTo = "erenaud@normandnet.fr" '
Required - Send to address
EMailCCTo = "" '' Optional
par ce bout de code:
(Je crois me souvenir que le séparateur
d'adresse de LotusNote est le ";"
sinon adapte)
'*************************
sep = ";"
For Each Cell In Range("Adresses_à")
x_à = x_à & sep & Cell.Value
Next
deb1:
If Right(x_à, 1) = sep Then x_à = _
Left(x_à, Len(x_à) - 1): GoTo deb1
deb2:
If Left(x_à, 1) = sep Then x_à = _
Right(x_à, Len(x_à) - 1): GoTo deb2
EMailSendTo = x_à
For Each Cell In Range("Adresses_cc")
x_cc = x_cc & sep & Cell.Value
Next
deb1:
If Right(x_cc, 1) = sep Then x_cc = _
Left(x_cc, Len(x_cc) - 1): GoTo deb1
deb2:
If Left(x_cc, 1) = sep Then x_cc = _
Right(x_cc, Len(x_cc) - 1): GoTo deb2
EMailCCTo = x_cc
'************************************
Cela devrait faire..................
--
Amicalement
Jean-François Aubert
{Vaudois de la Côte Lémanique}
"André" <anonymous@discussions.microsoft.com> a écrit
dans le message de
news:ff6d01c3f237$1a023060$a601280a@phx.gbl...
Dans l'excellent site EXCELLABO j'ai trouvé le code ci-
dessous pour envoyer un courrier (multi diffusion) avec
pièce jointe automatiquement par Lotus notes.
Avec ce code il y a autant de courrier expédié qu'il y a
de destinataires (soit 10 courriers pour 10
destinataires).
Comment peut-on aménager ce code pour adresser un seul
courrier à plusieurs personnes destinataires et en copie?
(1 courrier, 10 destinataires et 5 copies)
Merci de votre réponse
Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object
Function SendMail()
'mpep, auteur inconnu
On Error GoTo SendMailError
' Plage d'adresses e-mail dans une feuille de calcul
For Each Cell In Range("Adresses")
' Cas avec la plage
EMailSendTo = Cell.Value ' Required - Send to
address
' Cas avec une seule adresse
'EMailSendTo = "erenaud@normandnet.fr" '
Required - Send to address
EMailCCTo = "" '' Optional
EMailBCCTo = "" '' Optional
EmailSubject = "Envoi d'un document joint" '
Optional
''Establish Connection to Notes
Set objNotesSession = CreateObject
("Notes.NotesSession")
''Establish Connection to Mail File
'' .GETDATABASE
("SERVER", "FILE")
Set objNotesMailFile =
objNotesSession.GETDATABASE
("", "")
''Open Mail
objNotesMailFile.OPENMAIL
''Create New Memo
Set objNotesDocument =
objNotesMailFile.CREATEDOCUMENT
''Create 'Subject Field'
Set objNotesField =
objNotesDocument.APPENDITEMVALUE("Subject", EmailSubject)
''Create 'Send To' Field
Set objNotesField =
objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)
''Create 'Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("CopyTo",
EMailCCTo)
''Create 'Blind Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("BlindCopyTo",
EMailBCCTo)
''Create 'Body' of memo
Set objNotesField =
objNotesDocument.CREATERICHTEXTITEM("Body")
With objNotesField
.APPENDTEXT "Cet e-mail a été généré par un
processus automatique."
.ADDNEWLINE 1
.APPENDTEXT "This e-mail is generated by an
automated process."
'.APPENDTEXT "Please follow established
contact " & _
"procedures should you have any
questions."
.ADDNEWLINE 2
.APPENDTEXT "Cordialement"
.ADDNEWLINE 1
.APPENDTEXT "Eric RENAUD"
End With
''Attach the file --1454 indicate a file
attachment
objNotesField = _
objNotesField.EMBEDOBJECT(1454, "",
ActiveWorkbook.FullName)
''Send the e-mail
objNotesDocument.SEND (0)
Next Cell
''Release storage
Set objNotesSession = Nothing
Set bjNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing
''Set return code
SendMail = True
Exit Function
SendMailError:
Msg = "Error # " & Str(Err.Number) & " was generated
by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
SendMail = False
End Function
'Eric Renaud
.
-----Message d'origine-----
Salut André,
Nomme tes 2 plages d'adresses:
Adresses_à
Adresses_cc
Supprime les 2 lignes:
For Each Cell In Range("Adresses")
Next Cell
Remplace les lignes:
EMailSendTo = Cell.Value ' Required - Send to address
' Cas avec une seule adresse
'EMailSendTo = "" '
Required - Send to address
EMailCCTo = "" '' Optional
par ce bout de code:
(Je crois me souvenir que le séparateur
d'adresse de LotusNote est le ";"
sinon adapte)
'*************************
sep = ";"
For Each Cell In Range("Adresses_à")
x_à = x_à & sep & Cell.Value
Next
deb1:
If Right(x_à, 1) = sep Then x_à = _
Left(x_à, Len(x_à) - 1): GoTo deb1
deb2:
If Left(x_à, 1) = sep Then x_à = _
Right(x_à, Len(x_à) - 1): GoTo deb2
EMailSendTo = x_à
For Each Cell In Range("Adresses_cc")
x_cc = x_cc & sep & Cell.Value
Next
deb1:
If Right(x_cc, 1) = sep Then x_cc = _
Left(x_cc, Len(x_cc) - 1): GoTo deb1
deb2:
If Left(x_cc, 1) = sep Then x_cc = _
Right(x_cc, Len(x_cc) - 1): GoTo deb2
EMailCCTo = x_cc
'************************************
Cela devrait faire..................
--
Amicalement
Jean-François Aubert
{Vaudois de la Côte Lémanique}
"André" a écrit
dans le message de
news:ff6d01c3f237$1a023060$
Dans l'excellent site EXCELLABO j'ai trouvé le code ci-
dessous pour envoyer un courrier (multi diffusion) avec
pièce jointe automatiquement par Lotus notes.
Avec ce code il y a autant de courrier expédié qu'il y a
de destinataires (soit 10 courriers pour 10
destinataires).
Comment peut-on aménager ce code pour adresser un seul
courrier à plusieurs personnes destinataires et en copie?
(1 courrier, 10 destinataires et 5 copies)
Merci de votre réponse
Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object
Function SendMail()
'mpep, auteur inconnu
On Error GoTo SendMailError
' Plage d'adresses e-mail dans une feuille de calcul
For Each Cell In Range("Adresses")
' Cas avec la plage
EMailSendTo = Cell.Value ' Required - Send to
address
' Cas avec une seule adresse
'EMailSendTo = "" '
Required - Send to address
EMailCCTo = "" '' Optional
EMailBCCTo = "" '' Optional
EmailSubject = "Envoi d'un document joint" '
Optional
''Establish Connection to Notes
Set objNotesSession = CreateObject
("Notes.NotesSession")
''Establish Connection to Mail File
'' .GETDATABASE
("SERVER", "FILE")
Set objNotesMailFile =
objNotesSession.GETDATABASE
("", "")
''Open Mail
objNotesMailFile.OPENMAIL
''Create New Memo
Set objNotesDocument =
objNotesMailFile.CREATEDOCUMENT
''Create 'Subject Field'
Set objNotesField =
objNotesDocument.APPENDITEMVALUE("Subject", EmailSubject)
''Create 'Send To' Field
Set objNotesField =
objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)
''Create 'Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("CopyTo",
EMailCCTo)
''Create 'Blind Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("BlindCopyTo",
EMailBCCTo)
''Create 'Body' of memo
Set objNotesField =
objNotesDocument.CREATERICHTEXTITEM("Body")
With objNotesField
.APPENDTEXT "Cet e-mail a été généré par un
processus automatique."
.ADDNEWLINE 1
.APPENDTEXT "This e-mail is generated by an
automated process."
'.APPENDTEXT "Please follow established
contact " & _
"procedures should you have any
questions."
.ADDNEWLINE 2
.APPENDTEXT "Cordialement"
.ADDNEWLINE 1
.APPENDTEXT "Eric RENAUD"
End With
''Attach the file --1454 indicate a file
attachment
objNotesField = _
objNotesField.EMBEDOBJECT(1454, "",
ActiveWorkbook.FullName)
''Send the e-mail
objNotesDocument.SEND (0)
Next Cell
''Release storage
Set objNotesSession = Nothing
Set bjNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing
''Set return code
SendMail = True
Exit Function
SendMailError:
Msg = "Error # " & Str(Err.Number) & " was generated
by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
SendMail = False
End Function
'Eric Renaud
.
-----Message d'origine-----
Salut André,
Nomme tes 2 plages d'adresses:
Adresses_à
Adresses_cc
Supprime les 2 lignes:
For Each Cell In Range("Adresses")
Next Cell
Remplace les lignes:
EMailSendTo = Cell.Value ' Required - Send to address
' Cas avec une seule adresse
'EMailSendTo = "" '
Required - Send to address
EMailCCTo = "" '' Optional
par ce bout de code:
(Je crois me souvenir que le séparateur
d'adresse de LotusNote est le ";"
sinon adapte)
'*************************
sep = ";"
For Each Cell In Range("Adresses_à")
x_à = x_à & sep & Cell.Value
Next
deb1:
If Right(x_à, 1) = sep Then x_à = _
Left(x_à, Len(x_à) - 1): GoTo deb1
deb2:
If Left(x_à, 1) = sep Then x_à = _
Right(x_à, Len(x_à) - 1): GoTo deb2
EMailSendTo = x_à
For Each Cell In Range("Adresses_cc")
x_cc = x_cc & sep & Cell.Value
Next
deb1:
If Right(x_cc, 1) = sep Then x_cc = _
Left(x_cc, Len(x_cc) - 1): GoTo deb1
deb2:
If Left(x_cc, 1) = sep Then x_cc = _
Right(x_cc, Len(x_cc) - 1): GoTo deb2
EMailCCTo = x_cc
'************************************
Cela devrait faire..................
--
Amicalement
Jean-François Aubert
{Vaudois de la Côte Lémanique}
"André" a écrit
dans le message de
news:ff6d01c3f237$1a023060$
Dans l'excellent site EXCELLABO j'ai trouvé le code ci-
dessous pour envoyer un courrier (multi diffusion) avec
pièce jointe automatiquement par Lotus notes.
Avec ce code il y a autant de courrier expédié qu'il y a
de destinataires (soit 10 courriers pour 10
destinataires).
Comment peut-on aménager ce code pour adresser un seul
courrier à plusieurs personnes destinataires et en copie?
(1 courrier, 10 destinataires et 5 copies)
Merci de votre réponse
Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object
Function SendMail()
'mpep, auteur inconnu
On Error GoTo SendMailError
' Plage d'adresses e-mail dans une feuille de calcul
For Each Cell In Range("Adresses")
' Cas avec la plage
EMailSendTo = Cell.Value ' Required - Send to
address
' Cas avec une seule adresse
'EMailSendTo = "" '
Required - Send to address
EMailCCTo = "" '' Optional
EMailBCCTo = "" '' Optional
EmailSubject = "Envoi d'un document joint" '
Optional
''Establish Connection to Notes
Set objNotesSession = CreateObject
("Notes.NotesSession")
''Establish Connection to Mail File
'' .GETDATABASE
("SERVER", "FILE")
Set objNotesMailFile objNotesSession.GETDATABASE
("", "")
''Open Mail
objNotesMailFile.OPENMAIL
''Create New Memo
Set objNotesDocument >objNotesMailFile.CREATEDOCUMENT
''Create 'Subject Field'
Set objNotesField >objNotesDocument.APPENDITEMVALUE("Subject", EmailSubject)
''Create 'Send To' Field
Set objNotesField >objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)
''Create 'Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("CopyTo",
EMailCCTo)
''Create 'Blind Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("BlindCopyTo",
EMailBCCTo)
''Create 'Body' of memo
Set objNotesField >objNotesDocument.CREATERICHTEXTITEM("Body")
With objNotesField
.APPENDTEXT "Cet e-mail a été généré par un
processus automatique."
.ADDNEWLINE 1
.APPENDTEXT "This e-mail is generated by an
automated process."
'.APPENDTEXT "Please follow established
contact " & _
"procedures should you have any
questions."
.ADDNEWLINE 2
.APPENDTEXT "Cordialement"
.ADDNEWLINE 1
.APPENDTEXT "Eric RENAUD"
End With
''Attach the file --1454 indicate a file
attachment
objNotesField = _
objNotesField.EMBEDOBJECT(1454, "",
ActiveWorkbook.FullName)
''Send the e-mail
objNotesDocument.SEND (0)
Next Cell
''Release storage
Set objNotesSession = Nothing
Set bjNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing
''Set return code
SendMail = True
Exit Function
SendMailError:
Msg = "Error # " & Str(Err.Number) & " was generated
by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
SendMail = False
End Function
'Eric Renaud
.
-----Message d'origine-----
Salut André,
Nomme tes 2 plages d'adresses:
Adresses_à
Adresses_cc
Supprime les 2 lignes:
For Each Cell In Range("Adresses")
Next Cell
Remplace les lignes:
EMailSendTo = Cell.Value ' Required - Send to address
' Cas avec une seule adresse
'EMailSendTo = "erenaud@normandnet.fr" '
Required - Send to address
EMailCCTo = "" '' Optional
par ce bout de code:
(Je crois me souvenir que le séparateur
d'adresse de LotusNote est le ";"
sinon adapte)
'*************************
sep = ";"
For Each Cell In Range("Adresses_à")
x_à = x_à & sep & Cell.Value
Next
deb1:
If Right(x_à, 1) = sep Then x_à = _
Left(x_à, Len(x_à) - 1): GoTo deb1
deb2:
If Left(x_à, 1) = sep Then x_à = _
Right(x_à, Len(x_à) - 1): GoTo deb2
EMailSendTo = x_à
For Each Cell In Range("Adresses_cc")
x_cc = x_cc & sep & Cell.Value
Next
deb1:
If Right(x_cc, 1) = sep Then x_cc = _
Left(x_cc, Len(x_cc) - 1): GoTo deb1
deb2:
If Left(x_cc, 1) = sep Then x_cc = _
Right(x_cc, Len(x_cc) - 1): GoTo deb2
EMailCCTo = x_cc
'************************************
Cela devrait faire..................
--
Amicalement
Jean-François Aubert
{Vaudois de la Côte Lémanique}
"André" <anonymous@discussions.microsoft.com> a écrit
dans le message de
news:ff6d01c3f237$1a023060$a601280a@phx.gbl...
Dans l'excellent site EXCELLABO j'ai trouvé le code ci-
dessous pour envoyer un courrier (multi diffusion) avec
pièce jointe automatiquement par Lotus notes.
Avec ce code il y a autant de courrier expédié qu'il y a
de destinataires (soit 10 courriers pour 10
destinataires).
Comment peut-on aménager ce code pour adresser un seul
courrier à plusieurs personnes destinataires et en copie?
(1 courrier, 10 destinataires et 5 copies)
Merci de votre réponse
Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object
Function SendMail()
'mpep, auteur inconnu
On Error GoTo SendMailError
' Plage d'adresses e-mail dans une feuille de calcul
For Each Cell In Range("Adresses")
' Cas avec la plage
EMailSendTo = Cell.Value ' Required - Send to
address
' Cas avec une seule adresse
'EMailSendTo = "erenaud@normandnet.fr" '
Required - Send to address
EMailCCTo = "" '' Optional
EMailBCCTo = "" '' Optional
EmailSubject = "Envoi d'un document joint" '
Optional
''Establish Connection to Notes
Set objNotesSession = CreateObject
("Notes.NotesSession")
''Establish Connection to Mail File
'' .GETDATABASE
("SERVER", "FILE")
Set objNotesMailFile objNotesSession.GETDATABASE
("", "")
''Open Mail
objNotesMailFile.OPENMAIL
''Create New Memo
Set objNotesDocument >objNotesMailFile.CREATEDOCUMENT
''Create 'Subject Field'
Set objNotesField >objNotesDocument.APPENDITEMVALUE("Subject", EmailSubject)
''Create 'Send To' Field
Set objNotesField >objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)
''Create 'Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("CopyTo",
EMailCCTo)
''Create 'Blind Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("BlindCopyTo",
EMailBCCTo)
''Create 'Body' of memo
Set objNotesField >objNotesDocument.CREATERICHTEXTITEM("Body")
With objNotesField
.APPENDTEXT "Cet e-mail a été généré par un
processus automatique."
.ADDNEWLINE 1
.APPENDTEXT "This e-mail is generated by an
automated process."
'.APPENDTEXT "Please follow established
contact " & _
"procedures should you have any
questions."
.ADDNEWLINE 2
.APPENDTEXT "Cordialement"
.ADDNEWLINE 1
.APPENDTEXT "Eric RENAUD"
End With
''Attach the file --1454 indicate a file
attachment
objNotesField = _
objNotesField.EMBEDOBJECT(1454, "",
ActiveWorkbook.FullName)
''Send the e-mail
objNotesDocument.SEND (0)
Next Cell
''Release storage
Set objNotesSession = Nothing
Set bjNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing
''Set return code
SendMail = True
Exit Function
SendMailError:
Msg = "Error # " & Str(Err.Number) & " was generated
by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
SendMail = False
End Function
'Eric Renaud
.
-----Message d'origine-----
Salut André,
Nomme tes 2 plages d'adresses:
Adresses_à
Adresses_cc
Supprime les 2 lignes:
For Each Cell In Range("Adresses")
Next Cell
Remplace les lignes:
EMailSendTo = Cell.Value ' Required - Send to address
' Cas avec une seule adresse
'EMailSendTo = "" '
Required - Send to address
EMailCCTo = "" '' Optional
par ce bout de code:
(Je crois me souvenir que le séparateur
d'adresse de LotusNote est le ";"
sinon adapte)
'*************************
sep = ";"
For Each Cell In Range("Adresses_à")
x_à = x_à & sep & Cell.Value
Next
deb1:
If Right(x_à, 1) = sep Then x_à = _
Left(x_à, Len(x_à) - 1): GoTo deb1
deb2:
If Left(x_à, 1) = sep Then x_à = _
Right(x_à, Len(x_à) - 1): GoTo deb2
EMailSendTo = x_à
For Each Cell In Range("Adresses_cc")
x_cc = x_cc & sep & Cell.Value
Next
deb1:
If Right(x_cc, 1) = sep Then x_cc = _
Left(x_cc, Len(x_cc) - 1): GoTo deb1
deb2:
If Left(x_cc, 1) = sep Then x_cc = _
Right(x_cc, Len(x_cc) - 1): GoTo deb2
EMailCCTo = x_cc
'************************************
Cela devrait faire..................
--
Amicalement
Jean-François Aubert
{Vaudois de la Côte Lémanique}
"André" a écrit
dans le message de
news:ff6d01c3f237$1a023060$
Dans l'excellent site EXCELLABO j'ai trouvé le code ci-
dessous pour envoyer un courrier (multi diffusion) avec
pièce jointe automatiquement par Lotus notes.
Avec ce code il y a autant de courrier expédié qu'il y a
de destinataires (soit 10 courriers pour 10
destinataires).
Comment peut-on aménager ce code pour adresser un seul
courrier à plusieurs personnes destinataires et en copie?
(1 courrier, 10 destinataires et 5 copies)
Merci de votre réponse
Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object
Function SendMail()
'mpep, auteur inconnu
On Error GoTo SendMailError
' Plage d'adresses e-mail dans une feuille de calcul
For Each Cell In Range("Adresses")
' Cas avec la plage
EMailSendTo = Cell.Value ' Required - Send to
address
' Cas avec une seule adresse
'EMailSendTo = "" '
Required - Send to address
EMailCCTo = "" '' Optional
EMailBCCTo = "" '' Optional
EmailSubject = "Envoi d'un document joint" '
Optional
''Establish Connection to Notes
Set objNotesSession = CreateObject
("Notes.NotesSession")
''Establish Connection to Mail File
'' .GETDATABASE
("SERVER", "FILE")
Set objNotesMailFile objNotesSession.GETDATABASE
("", "")
''Open Mail
objNotesMailFile.OPENMAIL
''Create New Memo
Set objNotesDocument >objNotesMailFile.CREATEDOCUMENT
''Create 'Subject Field'
Set objNotesField >objNotesDocument.APPENDITEMVALUE("Subject", EmailSubject)
''Create 'Send To' Field
Set objNotesField >objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)
''Create 'Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("CopyTo",
EMailCCTo)
''Create 'Blind Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("BlindCopyTo",
EMailBCCTo)
''Create 'Body' of memo
Set objNotesField >objNotesDocument.CREATERICHTEXTITEM("Body")
With objNotesField
.APPENDTEXT "Cet e-mail a été généré par un
processus automatique."
.ADDNEWLINE 1
.APPENDTEXT "This e-mail is generated by an
automated process."
'.APPENDTEXT "Please follow established
contact " & _
"procedures should you have any
questions."
.ADDNEWLINE 2
.APPENDTEXT "Cordialement"
.ADDNEWLINE 1
.APPENDTEXT "Eric RENAUD"
End With
''Attach the file --1454 indicate a file
attachment
objNotesField = _
objNotesField.EMBEDOBJECT(1454, "",
ActiveWorkbook.FullName)
''Send the e-mail
objNotesDocument.SEND (0)
Next Cell
''Release storage
Set objNotesSession = Nothing
Set bjNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing
''Set return code
SendMail = True
Exit Function
SendMailError:
Msg = "Error # " & Str(Err.Number) & " was generated
by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
SendMail = False
End Function
'Eric Renaud
.
-----Message d'origine-----
Salut André,
ou avec l'accent: Adieu c't'ami André !
J'avais fait pour le boulot un fichier qui fait la même
chose que ce que tu veux faire,
et effectivement, je n'étais jamais arrivé à mettre
plusieurs destinataires à la fois.
Alors, pour les destinataires / copies qui sont toujours
les même,
j'ai fait des groupes de personnes dans LotusNotes.
Pour les autres, j'ai été contraint, à défaut de mieux,
de faire des boucles
(avec autant de courrier expédié qu'il y a de
destinataires...)
Ben ouai, ça fait un sacré chenit tout ça !
Adieu, et pis à la revoyure, hein donc
--
Amicalement
Jean-François Aubert
{Vaudois de la Côte Lémanique}
a écrit dans le
message de
news:1147001c3f48f$86b42740$
Merci de ta réponse.
j'ai testé avec séparateur sep=","
mais celà ne marche pas
seul le premier destinataire et le premier en copie
reçoivent le message
par contre sur le message reçu figurent bien toutes les
personnes destinataires et en copies
Amicalement
Adieu (façon suisse de dire au revoir, n'est-ce pas ?) et
bonjour au lac
André-----Message d'origine-----
Salut André,
Nomme tes 2 plages d'adresses:
Adresses_à
Adresses_cc
Supprime les 2 lignes:
For Each Cell In Range("Adresses")
Next Cell
Remplace les lignes:
EMailSendTo = Cell.Value ' Required - Send to address
' Cas avec une seule adresse
'EMailSendTo = "" '
Required - Send to address
EMailCCTo = "" '' Optional
par ce bout de code:
(Je crois me souvenir que le séparateur
d'adresse de LotusNote est le ";"
sinon adapte)
'*************************
sep = ";"
For Each Cell In Range("Adresses_à")
x_à = x_à & sep & Cell.Value
Next
deb1:
If Right(x_à, 1) = sep Then x_à = _
Left(x_à, Len(x_à) - 1): GoTo deb1
deb2:
If Left(x_à, 1) = sep Then x_à = _
Right(x_à, Len(x_à) - 1): GoTo deb2
EMailSendTo = x_à
For Each Cell In Range("Adresses_cc")
x_cc = x_cc & sep & Cell.Value
Next
deb1:
If Right(x_cc, 1) = sep Then x_cc = _
Left(x_cc, Len(x_cc) - 1): GoTo deb1
deb2:
If Left(x_cc, 1) = sep Then x_cc = _
Right(x_cc, Len(x_cc) - 1): GoTo deb2
EMailCCTo = x_cc
'************************************
Cela devrait faire..................
--
Amicalement
Jean-François Aubert
{Vaudois de la Côte Lémanique}
"André" a écrit
dans le message denews:ff6d01c3f237$1a023060$
Dans l'excellent site EXCELLABO j'ai trouvé le code ci-
dessous pour envoyer un courrier (multi diffusion) avec
pièce jointe automatiquement par Lotus notes.
Avec ce code il y a autant de courrier expédié qu'il y a
de destinataires (soit 10 courriers pour 10
destinataires).
Comment peut-on aménager ce code pour adresser un seul
courrier à plusieurs personnes destinataires et en
copie?
(1 courrier, 10 destinataires et 5 copies)
Merci de votre réponse
Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object
Function SendMail()
'mpep, auteur inconnu
On Error GoTo SendMailError
' Plage d'adresses e-mail dans une feuille de calcul
For Each Cell In Range("Adresses")
' Cas avec la plage
EMailSendTo = Cell.Value ' Required - Send to
address' Cas avec une seule adresse
'EMailSendTo = "" '
Required - Send to address
EMailCCTo = "" '' Optional
EMailBCCTo = "" '' Optional
EmailSubject = "Envoi d'un document joint" '
Optional
''Establish Connection to Notes
Set objNotesSession = CreateObject
("Notes.NotesSession")
''Establish Connection to Mail File
'' .GETDATABASE
("SERVER", "FILE")
Set objNotesMailFile =
objNotesSession.GETDATABASE("", "")
''Open Mail
objNotesMailFile.OPENMAIL
''Create New Memo
Set objNotesDocument =
objNotesMailFile.CREATEDOCUMENT
''Create 'Subject Field'
Set objNotesField =
objNotesDocument.APPENDITEMVALUE("Subject",
EmailSubject)
''Create 'Send To' Field
Set objNotesField =
objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)
''Create 'Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("CopyTo",
EMailCCTo)
''Create 'Blind Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("BlindCopyTo",
EMailBCCTo)
''Create 'Body' of memo
Set objNotesField =
objNotesDocument.CREATERICHTEXTITEM("Body")
With objNotesField
.APPENDTEXT "Cet e-mail a été généré par un
processus automatique."
.ADDNEWLINE 1
.APPENDTEXT "This e-mail is generated by an
automated process."
'.APPENDTEXT "Please follow established
contact " & _
"procedures should you have any
questions."
.ADDNEWLINE 2
.APPENDTEXT "Cordialement"
.ADDNEWLINE 1
.APPENDTEXT "Eric RENAUD"
End With
''Attach the file --1454 indicate a file
attachment
objNotesField = _
objNotesField.EMBEDOBJECT(1454, "",
ActiveWorkbook.FullName)
''Send the e-mail
objNotesDocument.SEND (0)
Next Cell
''Release storage
Set objNotesSession = Nothing
Set bjNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing
''Set return code
SendMail = True
Exit Function
SendMailError:
Msg = "Error # " & Str(Err.Number) & " was generated
by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
SendMail = False
End Function
'Eric Renaud
.
.
-----Message d'origine-----
Salut André,
ou avec l'accent: Adieu c't'ami André !
J'avais fait pour le boulot un fichier qui fait la même
chose que ce que tu veux faire,
et effectivement, je n'étais jamais arrivé à mettre
plusieurs destinataires à la fois.
Alors, pour les destinataires / copies qui sont toujours
les même,
j'ai fait des groupes de personnes dans LotusNotes.
Pour les autres, j'ai été contraint, à défaut de mieux,
de faire des boucles
(avec autant de courrier expédié qu'il y a de
destinataires...)
Ben ouai, ça fait un sacré chenit tout ça !
Adieu, et pis à la revoyure, hein donc
--
Amicalement
Jean-François Aubert
{Vaudois de la Côte Lémanique}
<anonymous@discussions.microsoft.com> a écrit dans le
message de
news:1147001c3f48f$86b42740$a501280a@phx.gbl...
Merci de ta réponse.
j'ai testé avec séparateur sep=","
mais celà ne marche pas
seul le premier destinataire et le premier en copie
reçoivent le message
par contre sur le message reçu figurent bien toutes les
personnes destinataires et en copies
Amicalement
Adieu (façon suisse de dire au revoir, n'est-ce pas ?) et
bonjour au lac
André
-----Message d'origine-----
Salut André,
Nomme tes 2 plages d'adresses:
Adresses_à
Adresses_cc
Supprime les 2 lignes:
For Each Cell In Range("Adresses")
Next Cell
Remplace les lignes:
EMailSendTo = Cell.Value ' Required - Send to address
' Cas avec une seule adresse
'EMailSendTo = "erenaud@normandnet.fr" '
Required - Send to address
EMailCCTo = "" '' Optional
par ce bout de code:
(Je crois me souvenir que le séparateur
d'adresse de LotusNote est le ";"
sinon adapte)
'*************************
sep = ";"
For Each Cell In Range("Adresses_à")
x_à = x_à & sep & Cell.Value
Next
deb1:
If Right(x_à, 1) = sep Then x_à = _
Left(x_à, Len(x_à) - 1): GoTo deb1
deb2:
If Left(x_à, 1) = sep Then x_à = _
Right(x_à, Len(x_à) - 1): GoTo deb2
EMailSendTo = x_à
For Each Cell In Range("Adresses_cc")
x_cc = x_cc & sep & Cell.Value
Next
deb1:
If Right(x_cc, 1) = sep Then x_cc = _
Left(x_cc, Len(x_cc) - 1): GoTo deb1
deb2:
If Left(x_cc, 1) = sep Then x_cc = _
Right(x_cc, Len(x_cc) - 1): GoTo deb2
EMailCCTo = x_cc
'************************************
Cela devrait faire..................
--
Amicalement
Jean-François Aubert
{Vaudois de la Côte Lémanique}
"André" <anonymous@discussions.microsoft.com> a écrit
dans le message de
news:ff6d01c3f237$1a023060$a601280a@phx.gbl...
Dans l'excellent site EXCELLABO j'ai trouvé le code ci-
dessous pour envoyer un courrier (multi diffusion) avec
pièce jointe automatiquement par Lotus notes.
Avec ce code il y a autant de courrier expédié qu'il y a
de destinataires (soit 10 courriers pour 10
destinataires).
Comment peut-on aménager ce code pour adresser un seul
courrier à plusieurs personnes destinataires et en
copie?
(1 courrier, 10 destinataires et 5 copies)
Merci de votre réponse
Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object
Function SendMail()
'mpep, auteur inconnu
On Error GoTo SendMailError
' Plage d'adresses e-mail dans une feuille de calcul
For Each Cell In Range("Adresses")
' Cas avec la plage
EMailSendTo = Cell.Value ' Required - Send to
address
' Cas avec une seule adresse
'EMailSendTo = "erenaud@normandnet.fr" '
Required - Send to address
EMailCCTo = "" '' Optional
EMailBCCTo = "" '' Optional
EmailSubject = "Envoi d'un document joint" '
Optional
''Establish Connection to Notes
Set objNotesSession = CreateObject
("Notes.NotesSession")
''Establish Connection to Mail File
'' .GETDATABASE
("SERVER", "FILE")
Set objNotesMailFile =
objNotesSession.GETDATABASE
("", "")
''Open Mail
objNotesMailFile.OPENMAIL
''Create New Memo
Set objNotesDocument =
objNotesMailFile.CREATEDOCUMENT
''Create 'Subject Field'
Set objNotesField =
objNotesDocument.APPENDITEMVALUE("Subject",
EmailSubject)
''Create 'Send To' Field
Set objNotesField =
objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)
''Create 'Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("CopyTo",
EMailCCTo)
''Create 'Blind Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("BlindCopyTo",
EMailBCCTo)
''Create 'Body' of memo
Set objNotesField =
objNotesDocument.CREATERICHTEXTITEM("Body")
With objNotesField
.APPENDTEXT "Cet e-mail a été généré par un
processus automatique."
.ADDNEWLINE 1
.APPENDTEXT "This e-mail is generated by an
automated process."
'.APPENDTEXT "Please follow established
contact " & _
"procedures should you have any
questions."
.ADDNEWLINE 2
.APPENDTEXT "Cordialement"
.ADDNEWLINE 1
.APPENDTEXT "Eric RENAUD"
End With
''Attach the file --1454 indicate a file
attachment
objNotesField = _
objNotesField.EMBEDOBJECT(1454, "",
ActiveWorkbook.FullName)
''Send the e-mail
objNotesDocument.SEND (0)
Next Cell
''Release storage
Set objNotesSession = Nothing
Set bjNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing
''Set return code
SendMail = True
Exit Function
SendMailError:
Msg = "Error # " & Str(Err.Number) & " was generated
by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
SendMail = False
End Function
'Eric Renaud
.
.
-----Message d'origine-----
Salut André,
ou avec l'accent: Adieu c't'ami André !
J'avais fait pour le boulot un fichier qui fait la même
chose que ce que tu veux faire,
et effectivement, je n'étais jamais arrivé à mettre
plusieurs destinataires à la fois.
Alors, pour les destinataires / copies qui sont toujours
les même,
j'ai fait des groupes de personnes dans LotusNotes.
Pour les autres, j'ai été contraint, à défaut de mieux,
de faire des boucles
(avec autant de courrier expédié qu'il y a de
destinataires...)
Ben ouai, ça fait un sacré chenit tout ça !
Adieu, et pis à la revoyure, hein donc
--
Amicalement
Jean-François Aubert
{Vaudois de la Côte Lémanique}
a écrit dans le
message de
news:1147001c3f48f$86b42740$
Merci de ta réponse.
j'ai testé avec séparateur sep=","
mais celà ne marche pas
seul le premier destinataire et le premier en copie
reçoivent le message
par contre sur le message reçu figurent bien toutes les
personnes destinataires et en copies
Amicalement
Adieu (façon suisse de dire au revoir, n'est-ce pas ?) et
bonjour au lac
André-----Message d'origine-----
Salut André,
Nomme tes 2 plages d'adresses:
Adresses_à
Adresses_cc
Supprime les 2 lignes:
For Each Cell In Range("Adresses")
Next Cell
Remplace les lignes:
EMailSendTo = Cell.Value ' Required - Send to address
' Cas avec une seule adresse
'EMailSendTo = "" '
Required - Send to address
EMailCCTo = "" '' Optional
par ce bout de code:
(Je crois me souvenir que le séparateur
d'adresse de LotusNote est le ";"
sinon adapte)
'*************************
sep = ";"
For Each Cell In Range("Adresses_à")
x_à = x_à & sep & Cell.Value
Next
deb1:
If Right(x_à, 1) = sep Then x_à = _
Left(x_à, Len(x_à) - 1): GoTo deb1
deb2:
If Left(x_à, 1) = sep Then x_à = _
Right(x_à, Len(x_à) - 1): GoTo deb2
EMailSendTo = x_à
For Each Cell In Range("Adresses_cc")
x_cc = x_cc & sep & Cell.Value
Next
deb1:
If Right(x_cc, 1) = sep Then x_cc = _
Left(x_cc, Len(x_cc) - 1): GoTo deb1
deb2:
If Left(x_cc, 1) = sep Then x_cc = _
Right(x_cc, Len(x_cc) - 1): GoTo deb2
EMailCCTo = x_cc
'************************************
Cela devrait faire..................
--
Amicalement
Jean-François Aubert
{Vaudois de la Côte Lémanique}
"André" a écrit
dans le message denews:ff6d01c3f237$1a023060$
Dans l'excellent site EXCELLABO j'ai trouvé le code ci-
dessous pour envoyer un courrier (multi diffusion) avec
pièce jointe automatiquement par Lotus notes.
Avec ce code il y a autant de courrier expédié qu'il y a
de destinataires (soit 10 courriers pour 10
destinataires).
Comment peut-on aménager ce code pour adresser un seul
courrier à plusieurs personnes destinataires et en
copie?
(1 courrier, 10 destinataires et 5 copies)
Merci de votre réponse
Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object
Function SendMail()
'mpep, auteur inconnu
On Error GoTo SendMailError
' Plage d'adresses e-mail dans une feuille de calcul
For Each Cell In Range("Adresses")
' Cas avec la plage
EMailSendTo = Cell.Value ' Required - Send to
address' Cas avec une seule adresse
'EMailSendTo = "" '
Required - Send to address
EMailCCTo = "" '' Optional
EMailBCCTo = "" '' Optional
EmailSubject = "Envoi d'un document joint" '
Optional
''Establish Connection to Notes
Set objNotesSession = CreateObject
("Notes.NotesSession")
''Establish Connection to Mail File
'' .GETDATABASE
("SERVER", "FILE")
Set objNotesMailFile =
objNotesSession.GETDATABASE("", "")
''Open Mail
objNotesMailFile.OPENMAIL
''Create New Memo
Set objNotesDocument =
objNotesMailFile.CREATEDOCUMENT
''Create 'Subject Field'
Set objNotesField =
objNotesDocument.APPENDITEMVALUE("Subject",
EmailSubject)
''Create 'Send To' Field
Set objNotesField =
objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)
''Create 'Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("CopyTo",
EMailCCTo)
''Create 'Blind Copy To' Field
Set objNotesField = _
objNotesDocument.APPENDITEMVALUE("BlindCopyTo",
EMailBCCTo)
''Create 'Body' of memo
Set objNotesField =
objNotesDocument.CREATERICHTEXTITEM("Body")
With objNotesField
.APPENDTEXT "Cet e-mail a été généré par un
processus automatique."
.ADDNEWLINE 1
.APPENDTEXT "This e-mail is generated by an
automated process."
'.APPENDTEXT "Please follow established
contact " & _
"procedures should you have any
questions."
.ADDNEWLINE 2
.APPENDTEXT "Cordialement"
.ADDNEWLINE 1
.APPENDTEXT "Eric RENAUD"
End With
''Attach the file --1454 indicate a file
attachment
objNotesField = _
objNotesField.EMBEDOBJECT(1454, "",
ActiveWorkbook.FullName)
''Send the e-mail
objNotesDocument.SEND (0)
Next Cell
''Release storage
Set objNotesSession = Nothing
Set bjNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing
''Set return code
SendMail = True
Exit Function
SendMailError:
Msg = "Error # " & Str(Err.Number) & " was generated
by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
SendMail = False
End Function
'Eric Renaud
.
.