Envoi d'un mail depuis une liste sur excel

[Brigitte]

Bonjour,

Je pense que ce sujet a été traité mille fois, dans tous les sens. Mais je ne trouve pas mon bonheur ou comment formuler ma recherche.

Nous avons un fichier excel (pas besoin de le joindre, c juste la philosophie) reprenant une base de données : nom, prénom, adresse, email...

Ce fichier sert à faire des invitations depuis word (fusion) mais nous voudrions n'envoyer des invitations qu'aux personnes (en cochant une case par exemple) qui n'ont pas d'email. Jusque là on sait faire (requête : si pas présence d'email).

Pour faire donc des économies substantielles, nous voudrions parallèlement, envoyer cette invitation en pièce jointe (ou dans le corps de l'email) par mail aux seules personnes disposant d'une adresse email.

Nous avons trouvé la parade en faisant une liste de distribution outlook, mais cela suppose la mise à jour de deux fichiers : excel et outlook. Si on pouvait cliquer dans le fichier excel sur un bouton et que ca déclenche un mail outlook en reprenant les boîtes aux lettres présentes dans la colonne "email", ce serait fabuleux.

Je précise qu'envoyer une des feuilles d'un classeur par mail, on sait le faire, j'ai mis un bouton dans un autre classeur et quand je clique ca ouvre outlook, ca joint le fichier : mais il faut que je tape les emails...

Sub MacroMail()
Dim AccuseReception As Boolean
Dim Sujet As String
      '
      ActiveWorkbook.Windows(1).SelectedSheets.Copy
      AccuseReception = True
      Sujet = "Titre au choix"
      ActiveWorkbook.SendMail "", Sujet, AccuseReception
      ActiveWorkbook.Close False
End Sub

Donc c une combinaison de tout ca qui nous intéresserait.

Une idée ?

Merci à vous.

 

[Brigitte]

Re : Envoi d'un mail depuis une liste sur excel

Merci... Mais je pense que le pb est résolu, vous embêtez plus, il me faut pas trente six mille solutions... Mais bon le fil hébergera tout ca et ca pourra servir à d'autres...

 

[Brigitte]

Re : Envoi d'un mail depuis une liste sur excel

Je viens de regarder, c bien ca Christophe... Mais ca m'embête un peu de mettre tout ca au dessus du fichier. Merci beaucoup beaucoup de tout ce que vous avez tous fait.

 

[Tophe2]

Re : Envoi d'un mail depuis une liste sur excel

Bonjour Brigitte
Tu peux le mettre à un autre endroit soit très loin dans ta feuille ou sur une autre feuille.
Ici à mettre dans un Module

Sub Message1()
Dim I As Integer, MailTo As String, MailCC As String
Dim vPJ, vPJ1, vPJ2, vPJ3, vPJ4, vPJ5, vPJ6, vPJ7, vPJ8, vPJ9, vLigne
Dim OLApplication As Outlook.Application, OLMail As Outlook.MailItem
Set OLApplication = CreateObject("Outlook.Application")
Set OLMail = OLApplication.CreateItem(OLMailItem)

For I = 15 To 200 ' A changer si le début pas la ligne 15
If Cells(I, 10) = "X" Then ' colonne J = 10
MailTo = MailTo & Cells(I, 9) & ";" ' 3 pour regarder _
ta colonne I=9 si c'est là où est l'adresse, à modifier pour ton cas
End If
If Cells(I, 10) = "C" Then
MailCC = MailCC & Cells(I, 9) & ";"
End If
If Cells(I, 10) = "I" Then
MailBCC = MailBCC & Cells(I, 9) & ";"
End If

Next I
ObjetMessage = Cells(2, 4) ' A changer car ici il y aura l'objet du message

'Récup. message, avec sauts de ligne
For Each vLigne In [F2:F13] ' A changer endroit ou tu écris le messgae via excel
CorpsMessage = CorpsMessage & vLigne & vbLf
Next ' La suite également
vPJ = Range("I3")
vPJ1 = Range("I4")
vPJ2 = Range("I5")
vPJ3 = Range("I6")
vPJ4 = Range("I7")
vPJ5 = Range("I8")
vPJ6 = Range("I9")
vPJ7 = Range("I10")
vPJ8 = Range("I11")
vPJ9 = Range("I12")
With OLMail
.To = MailTo ' Destinataire
.CC = MailCC ' Copie
.BCC = MailBCC ' Invisible
.Importance = olImportanceNormal
.Subject = ObjetMessage ' Sujet
.Body = CorpsMessage ' Message
''''''''''' .Attachments = vPJ 'Pièce jointe
On Error Resume Next

For J = 3 To 12 ' Ici encore à changer
If Range("I" & J).Value <> "" Then
.Attachments.Add Range("I" & J).Value 'j'ai juste ajoute cela
End If
Next J
.Categories = "Daily"
.OriginatorDeliveryReportRequested = True ' Accusé de dépôt
.ReadReceiptRequested = True ' Accusé de lecture
' .Send '<<<<<<<<<<<<<<<Pour envoyer directement
.Display '<<<<<<<<<<<<<Pour voir le mail avant envoi
End With

End Sub

Sub Chem() ''''' OK pour Jean Marie cela fonctionne
Dim Chemin As String 'nom de variable récupérant le chemin du fichier
Set F2 = Worksheets("répertoire")

Chemin = Application.GetOpenFilename
If Chemin <> "Faux" Then 'et pas False I speak french Lol
F2.Range("I1").End(xlDown).Offset(1, 0) = Chemin 'Ici encore à changer I1
End If

End Sub

A mettre dans le code de la feuille ou se trouvera la posibilité d'écrire le message.

Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
If target.Address = "$I$1" Then Chem 'A changer endroit ou se trouvera les pièces jointes
ActiveSheet.[I2].Select 'Idem
End Sub

Bonne journée
Christophe.