Macro avec Destinataires aléatoires pour mail Lotus

Question

Bonjour, 

Je voudrai expédier un mail avec pièce jointe avec Lotus à partir de la pièce jointe ouverte(VBA avec xls). Jusque là, pas de soucis. Par contre, je voudrai également que pour le mail les destinataires soient choisis dans certaines cellules puisqu'ils changent (toujours au même emplacement dans le document) à la place d'un destinataire programmé, Quelqu'un a-t-il une idée? Merci d'avance à tous.

cs_Joh76 · Answer

Bonjour,

Si tu as les noms des destinataires dans les cellules A1, A2 et A3 de la feuille 1:

Dim Principaux (2) as String

Principaux(0)=feuil1.range("A1").value
Principaux(1)=feuil1.range("A2").value
Principaux(2)=feuil1.range("A3").value

Dans la méthode d'envoie de l'email tu mets:

doc.SendTo = Principaux 

Cordialement

cs_TON1 · Answer

Bonjour, 

Merci pour ta solution Joh76. Je pense sue je l'ai mal intégrée à mon code ou que je ne maîtrise pas la syntaxe avec " Call doc.APPENDITEMVALUE": Voici ce que cela donne: 

 Sub Bouton330_Clic()
'Demande de ligne pour envoi de mail et surtout pour destinataire
Dim MaLigne As Integer
    
    MaLigne = InputBox("Quelle Ligne ?", "Sélection ligne", 0)
    If MaLigne = 0 Then Exit Sub
    
    
    Dim Session As Object
    Dim db As Object
    Dim doc As Object
    Dim rtitem As Object
    Dim object As Object
    Dim fs As Object
    Dim Principaux(2) As String
Principaux(0) = Ordre_de_transport.Range("M10").Value
Principaux(1) = Ordre_de_transport.Range("M11").Value
Principaux(2) = Ordre_de_transport.Range("M12").Value
Principaux(3) = Ordre_de_transport.Range("D8").Value
    Dim dir As Object
    Dim inti As Integer
    Dim passwd As String
     
    On Error GoTo TraiteErreur
    
    'Demande le password Lotus(Dans le cas ou la session necessite un passwd)
    passwd = InputBox("Entrer votre password Lotus:", "Password")
    
    ' Création de la session Notes
    Set Session = CreateObject("Lotus.NOTESSESSION")
    
    'Ouverture d'une session NOTES
    Call Session.Initialize(passwd) 'si pas de passwd pas de parametre pour initialize
    Set dir = Session.GETDBDIRECTORY("")
    Set db = dir.OpenMailDatabase
    
    ' Création d'un document
    Set doc = db.CREATEDOCUMENT
    'affectation du type mail
   
    Call doc.APPENDITEMVALUE("Form", "Memo")
    Call doc.APPENDITEMVALUE("Sendto", "Principaux") ' ATT plusieurs dest
    Call doc.APPENDITEMVALUE("subject", "Confirmation d'envoi")
    doc.SAVEMESSAGEONSEND = saveit 'sauvegarde du mail à l envoi
    
    
    'Si plusieurs destinataires alors mettre:
    'Dim recip(25) as variant
    'recip(0)="email" etc
    
    Set rtitem = doc.createRichTextItem("Body")
    
    
    Dim nom As String
    nom = ThisWorkbook.FullName
    'Attachement du classeur au mail
    Set object = rtitem.embedObject
1454, "", "G:\Specifiques\Taxi\Taxi.xls", "")
    
    Call doc.Send(True)
    Set object = Nothing
    Set rtitem = Nothing
    Set doc = Nothing
    Set db = Nothing
    Set Session = Nothing
    Exit Sub
TraiteErreur:
    MsgBox "Erreur Critique durant l envoi .", vbCritical, "Error"
    Set object = Nothing
    Set rtitem = Nothing
    Set doc = Nothing
    Set db = Nothing
    Set Session = Nothing
    Set fs = Nothing
End Sub

Merci bien pour ton aide. 

TON1

cs_Joh76 · Answer

Bonjour,

Regarde ça, en ajoutant la partie mot de passe ça devrait fonctionner.

Sub Test()
    Dim A As String 'Destinataire du mail
    Dim CC As String 'Destinataire en copie
    Dim Objet As String ' Objet du mail
    Dim Corps As String 'Corps du mail
    Dim Fichier As String ' Fichier a envoyer
    
    A = AdresseEmail(Worksheets("Ordre_de_transport").Range("M10").Value, _
Worksheets("Ordre_de_transport").Range("M11").Value _
        , Worksheets("Ordre_de_transport").Range("M12").Value, Worksheets("Ordre_de_transport").Range("D8").Value)
        
    'CC=AdresseEmail(...)
    
    Objet = "Test sous lotus"
    
    Corps = "Partie pricipale du email"
    
    Fichier = ThisWorkbook.Path & "" & ThisWorkbook.Name 'Envoie de ce classeur
    
    'Envoie du mail
    
    EnvoiEmail Destinataires:=A, VarObjet:=Objet, Corps:=Corps, FichierAttache:=Fichier
    
End Sub

Private Function AdresseEmail(ParamArray Adresses() As Variant) As Variant
    Dim Adresse As Variant
    Dim Destinataires() As String
    Dim i As Integer 'itération
    If Not IsNull(Adresses) Then
        i = 0
        For Each Adresse In Adresses
            ReDim Preserve Destinataires(i)
            Destinataires(i) = Adresse
            i = i + 1
        Next Adresse
    AdresseEmail = Destinataires
    End If
End Function

Public Function EnvoiEmail(Destinataires As String, Copies As String, VarObjet As String, Corps As String,_
FichierAttache As String)
'a utiliser avec Lotus Notes
'Pb car il génère des mails de 240 000 octets
Dim Session As Object
Dim doc As Object
Dim rtitem As Object
Dim object As Object

Dim Vari As String
Dim j As Integer

Dim dbl As Object


          '============================================================
            'Fonctionne avec Lotus Notes
            On Error Resume Next
            ' Ouverture d'une session NOTES
            Set Session = CreateObject("Notes.NotesSession")       'pour Lotus
            If Err = 0 Then
                Set dbl = Session.GETDATABASE("", "")       'pour Lotus
                Call dbl.OPENMAIL       'pour Lotus
    
                ' Création du mail
                Set doc = dbl.CREATEDOCUMENT()       'pour Lotus
                doc.form = "Memo"       'pour Lotus
            
                ' Destinataires principaux
    
                doc.SendTo = Destinataires     'pour Lotus
            
                ' Destinataires en copie
                'doc.CopyTo = Copies       'pour Lotus
                doc.Subject = VarObjet    'pour Lotus
                doc.ReturnReceipt = "1"
    
            
                ' Corps du mail
                Set rtitem = doc.createRichTextItem("Body")       'pour Lotus
                Call rtitem.appendText(Corps)       'pour Lotus
            
                'cette commande sert à envoyer un fichier attaché
                Set object = rtitem.embedObject(1454, "", FichierAttache, "")     'pour Lotus
            
                ' Envoi du mail
                'Call doc.Save(True, True)       'pour Lotus
                Call doc.SEND(True)             'pour Lotus
            
                'initialisation des Objets Lotus
                Set Session = Nothing
                Set dbl = Nothing
                Set doc = Nothing
                Set rtitem = Nothing
                Set object = Nothing
            Else
                MsgBox "L'e-mail n'a pu être envoyé, vérifiez votre connexion Lotus...", vbCritical
            End If
End Function

cs_Joh76 · Answer

Petite erreur, il faut remplacer:
EnvoiEmail Destinataires:=A, VarObjet:=Objet, Corps:=Corps, FichierAttache:=Fichier 
par
EnvoiEmail Destinataires:=A, Copies:="", VarObjet:=Objet, Corps:=Corps, FichierAttache:=Fichier
dans sub Test ()

Cordialement

cs_TON1 · Answer

Le programme bloque au niveau d'Envoimail . Il me met "une erreur de compilation avec Sub ou Function attendu". 
De même un petit peu après, la phrase suivante est en rouge donc il doit y avoir un soucis:
"Public Function EnvoiEmail(Destinataires As String, Copies As String, VarObjet As String, Corps As String,_
FichierAttache As String)"

En tout cas merci bcp

cs_Joh76 · Answer

Autant pour moi, essais ceci...

Sub Test()

    Dim A() As String  'Destinataire du mail
    Dim CC() As String 'Destinataire en copie
    Dim Objet As String ' Objet du mail
    Dim Corps As String 'Corps du mail
    Dim Fichier As String ' Fichier a envoyer
    
    A = AdresseEmail(Worksheets("Ordre_de_transport").Range("M10").Value, _ 
Worksheets("Ordre_de_transport").Range("M11").Value _ 
, Worksheets("Ordre_de_transport").Range("M12").Value, Worksheets("Ordre_de_transport").Range("D8").Value)
        
    'CC=AdresseEmail(...)
    
    Objet = "Test sous lotus"
    
    Corps = "Partie pricipale du email"
    
    Fichier = ThisWorkbook.Path & "" & ThisWorkbook.Name 'Envoie de ce classeur
    
    'Envoie du mail
    
    EnvoiEmail Destinataires:=A, Copies:="", VarObjet:=Objet, Corps:=Corps, FichierAttache:=Fichier
    
End Sub

Private Function AdresseEmail(ParamArray Adresses() As Variant) As Variant
    Dim Adresse As Variant
    Dim Destinataires() As String
    Dim i As Integer 'itération
    If Not IsNull(Adresses) Then
        i = 0
        For Each Adresse In Adresses
            ReDim Preserve Destinataires(i)
            Destinataires(i) = Adresse
            i = i + 1
        Next Adresse
    AdresseEmail = Destinataires
    End If
End Function

Public Function EnvoiEmail(Destinataires() As String, Copies() As String, VarObjet As String, Corps As String, FichierAttache As String)
'a utiliser avec Lotus Notes
'Pb car il génère des mails de 240 000 octets
Dim Session As Object
Dim doc As Object
Dim rtitem As Object
Dim object As Object

Dim Vari As String
Dim j As Integer

Dim dbl As Object


          '============================================================
            'Fonctionne avec Lotus Notes
            On Error Resume Next
            ' Ouverture d'une session NOTES
            Set Session = CreateObject("Notes.NotesSession")       'pour Lotus
            If Err = 0 Then
                Set dbl = Session.GETDATABASE("", "")       'pour Lotus
                Call dbl.OPENMAIL       'pour Lotus
    
                ' Création du mail
                Set doc = dbl.CREATEDOCUMENT()       'pour Lotus
                doc.form = "Memo"       'pour Lotus
            
                ' Destinataires principaux
    
                doc.SendTo = Destinataires     'pour Lotus
            
                ' Destinataires en copie
                'doc.CopyTo = Copies       'pour Lotus
                doc.Subject = VarObjet    'pour Lotus
                doc.ReturnReceipt = "1"
    
            
                ' Corps du mail
                Set rtitem = doc.createRichTextItem("Body")       'pour Lotus
                Call rtitem.appendText(Corps)       'pour Lotus
            
                'cette commande sert à envoyer un fichier attaché
                Set object = rtitem.embedObject(1454, "", FichierAttache, "")     'pour Lotus
            
                ' Envoi du mail
                'Call doc.Save(True, True)       'pour Lotus
                Call doc.SEND(True)             'pour Lotus
            
                'initialisation des Objets Lotus
                Set Session = Nothing
                Set dbl = Nothing
                Set doc = Nothing
                Set rtitem = Nothing
                Set object = Nothing
            Else
                MsgBox "L'e-mail n'a pu être envoyé, vérifiez votre connexion Lotus...", vbCritical
            End If
End Function

Macro avec Destinataires aléatoires pour mail Lotus

6 réponses

Votre réponse

Discussions similaires