Envoi de Mail à partir d'Excel

**jérémyp8** · 01/08/2013, 13h42

Bonjour a tous,

Dans mon fichier Excel, dans la colonnes "J " j'ai le Nom et Pernom de trois personnes qui sont des chefs de projet

Ce que je veux faire, c'est de realiser une macro qui identifié le nom et prenom de chaque de ces personne pour leur envoyer un mail.

Je veux proceder comme suit car j'ai des raisons qui sont longues expliquer :

1. Dans le code je metterai les mails de ces personnes en dur sachant que tous les mails ont cette forme prenom.nom@hotmail.fr

2. Puis je veux comparer les noms des personnes qui sont dans la colonne J aux mails posés dans le code
si un nom et prenom sont identiquent au début d'un mail bien sur avant le "@" et sans prendre en compte le point (.) qui entre le nom et prenom du mail alors on envoit le mail avec un corps de texte et objet a définir a cette personne

Remarque :
En effet j'ai oublié de préciser que lenvoi de mail se fait avec Outlook

Voila en pièce jointe un exemple de fichier Excel

Merci

Invité · 01/08/2013, 19h13

Le code complet pour réaliser ce que tu souhaites faire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Option Explicit
 
'Envoi du mail
Public Sub EnvoiMail()
 
  Dim myOlApp As New Outlook.Application
  Dim myOlIte As MailItem
 
  Set myOlApp = New Outlook.Application
  Set myOlIte = myOlApp.CreateItem(olMailItem)
 
  With myOlIte
    .To = ListeMailEnvoi
    .Subject = "Objet du mail"
    .Body = "Corps du texte"
    '.Attachments.Add ""
    .Send 'Envoi
  End With
 
End Sub
 
'Création de la liste d'envoi
Public Function ListeMailEnvoi() As String
 
  Dim strPrenom As String, strNom As String, strAdresse As String
  Dim tabMail() As Variant
  Dim tabEnvoi As Collection
  Dim strEnvoi As String
  Dim lngLigne As Long
  Dim rngC As Range
  Dim i As Integer
 
  With Worksheets("Feuil1")
 
    Set tabEnvoi = New Collection
 
    'Liste des adresses mail
    tabMail = Array("eric.martab@hotmail.fr", "christian.gillou@hotmail.fr")
 
    lngLigne = .Range("J" & .Rows.Count).End(xlUp).Row
 
    For Each rngC In .Range(.[J1], .Cells(lngLigne, 10))
      If rngC.Value <> "" Then
        strPrenom = LCase(Split(rngC.Value, " ")(0))
        strNom = LCase(Split(rngC.Value, " ")(1))
        strAdresse = strPrenom & "." & strNom & "@hotmail.fr"
        If IsInArray(strAdresse, tabMail) = True Then
          On Error Resume Next
            tabEnvoi.Add strAdresse, strAdresse
          On Error GoTo 0
        End If
      End If
    Next rngC
 
  End With
 
  'Création de la liste d'envoi
  For i = 1 To tabEnvoi.Count
    ListeMailEnvoi = ListeMailEnvoi & tabEnvoi.Item(i) & "; "
  Next i
 
End Function
 
'Fonction renvoyant "TRUE" si l'élement appartient au tableau passé en paramètre
Public Function IsInArray(FindValue As Variant, arrSearch As Variant) As Boolean
    If Not IsArray(arrSearch) Then Exit Function
    IsInArray = InStr(1, vbNullChar & Join(arrSearch, _
     vbNullChar) & vbNullChar, vbNullChar & FindValue & _
     vbNullChar) > 0
End Function

Il est nécessaire d'activer la référence Microsoft Outlook XX.X Object Library ou sinon de tout coder en 'late binding'.

**graphikris** · 01/08/2013, 19h26

Si çà peut t'aider vas voir ici, çà va certainement te convenir.

A+

**jérémyp8** · 02/08/2013, 10h23

Bonjour à tous

Graphikris merci pour ton lien il très est intréssant je vais le voir

Vcottineau
Merci de s'intresser à mon probleme..je viens de tester ta macro elle fonctionne a merveille elle fait excetement ce que j'ai demandé merci beacoup

Ce qui reste à faire :

Dans le fichier Excel ça se peu que les noms et pernoms de ces trois personnes se repète plusieurs fois car ils sont résponsables sur beaucoup de projets.

Ce que je veux faire : c'est d'envoyer un seul mail récapulatif à chaque de ces trois personnes en mettant dans le corp du message une phrase + les noms de tous les pojets sur lesquels ils sont reponsables

Les noms des projets de chaque personne sont sur la meme ligne que leurs nom et prénom exactement dans la colonne A colorés en Vert)

Merci

Invité · 02/08/2013, 10h44

Dans le code j'utilise une collection qui permet justement d'enlever les doublons...

Pour ce que tu souhaites faire tu peux utiliser un module de classe qui reprend les données propres à chaque personne.

J'ai pas le temps de m'en occuper maintenant mais tu peux déjà commencer.

**jérémyp8** · 05/08/2013, 10h20

Bonjour vcottineau

Merci pour ta réponse...enfaite avant je faisais un test que sur trois personnes de nom différents donc j'ai pas remarqué que tu as tenu compte du cas ou y aura une plusieurs fois le nom d'une même personne

Donc mon 1er Pb est résolu..MAIS la macro ne prend pas en compte dans le cas ou ya autre chose que le nom et prénom dans la colonne J, j'ai fait le test et la macro beug

En plus si ya un nom avec accent le mail n est pas envoyer a cette personne sachant que dans une adresse mail ya pas d'accent

Merci encore une fois

Invité · 07/08/2013, 10h21

Voila déjà deux méthodes pour enlever les accents dans une chaine de caractère. Utiliser l'API Windows est plus efficace.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Option Explicit
 
Private Declare Function FoldString Lib "kernel32" Alias "FoldStringA" (ByVal dwMapFlags As Byte, ByVal lpSrcStr As Long, ByVal cchSrc As Long, ByVal lpDestStr As Long, ByVal cchdest As Long) As Long
 
Public Sub Test()
  Debug.Print (EnleverAccents("ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"))
  Debug.Print (EnleverAccents("0ZnÁrÄPË43ÑertÔÙdwxÛâçérðpõûÿ"))
  Debug.Print (EnleverAccentsBis("ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"))
  Debug.Print (EnleverAccentsBis("0ZnÁrÄPË43ÑertÔÙdwxÛâçérðpõûÿ"))
End Sub
 
Function EnleverAccentsBis(Chaine As String) As String
 
 Dim intTemp As Integer
 
 EnleverAccentsBis = Space(Len(Chaine))
 
 For intTemp = 0 To Len(Chaine) * 2 - 2 Step 2
  FoldString &H40, StrPtr(Chaine) + intTemp, 1, StrPtr(EnleverAccentsBis) + intTemp, 1
 Next intTemp
 
End Function
 
Public Function EnleverAccents(ByVal Chaine) As String
 
  Dim strAvecAccent As String, strSansAccent As String
  Dim intTemp As Integer, strTemp As String
 
  strAvecAccent = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
  strSansAccent = "AAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
 
  Chaine = Replace(Replace(Replace(Replace(Chaine, "oe", "oe"), "OE", "OE"), "æ", "ae"), "Æ", "AE")
 
  For intTemp = 1 To Len(Chaine)
    strTemp = InStr(1, strAvecAccent, Mid(Chaine, intTemp, 1), 0)
    If strTemp Then Mid(Chaine, intTemp, 1) = Mid(strSansAccent, strTemp, 1)
  Next intTemp
 
  EnleverAccents = Chaine
 
End Function

En PJ le fichier permettant de supprimer les accents et d'éviter les erreur lorsque qu'il y a autre chose que le nom et le prénom dans la cellule.

Pour le reste je vais regarder dans la journée.

Ce que je veux faire : c'est d'envoyer un seul mail récapulatif à chaque de ces trois personnes en mettant dans le corp du message une phrase + les noms de tous les pojets sur lesquels ils sont reponsables

Tu veux un seul mail pour l'ensemble des personnes avec le détail de chaque personnes dans le corps du mail et pas un mail par personne avec les projets associés?

**jérémyp8** · 07/08/2013, 10h53

Bonjour vcottineau,

Encore une fois un grand merci à toi d'avoir consacrer du temps pour m'aider...Respect à toi

En effet ce que je veux c'est envoyer un mail par personne avec les projets associés

Merci

Invité · 07/08/2013, 11h15

En PJ l'amélioration du code avec utilisation d'un module de classe. Un mail est envoyé à toutes les personnes avec le détail des projets associés.

Si tu veux envoyer un mail par personne tu dois pourvoir te débrouiller par toi-même puisque c'est plus simple.

**jérémyp8** · 08/08/2013, 11h02

Re vcottineau,

Ta macro fonctionne très bien...il me reste juste à envoyer un mail individuel par personne avec ces propres projets

Encore une fois un enorme merci pour toi

Si en meme temps quelqu'un dautre peux m'aider sur cela je serai très reconnaissant car je suis débutant

En attendant je vais essayer de le faire par moi meme !