Discussion :

[mdb008]

Bonjour,

J'ai créé une macro qui me permet d'envoyer un mail automatique aux adresses mail figurant dans mon tableau excel lorsque certaines conditions sont respectées.

Actuellement, pour que le mail soit envoyé, il faut donc que je rentre manuellement les adresses mail correspondant à chaque personne présente dans le tableau. Sachant que je rentre aussi le nom + prénom des personnes, est-ce qu'il ne serait pas possible de récupérer automatiquement l'adresse mail dans le carnet d'adresse outlook de mon entreprise (contacts partagés, pas contacts perso) ?

Voici le code que je souhaite modifier. Vous trouverez également le fichier en PJ pour mieux comprendre.

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
     'Définition des variables
    Public Sub EnvoiMailRappel()
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Dim adresse As String
    Dim message As String
    Dim sujet As String
 
    sujet = "Retour Prêt" 'Définition du sujet de l'email
    For i = 3 To Range("a" & Rows.Count).End(xlUp).Row 'Définition de la plage de test (de la 3ème ligne jusqu'à première cellule vide de la colonne a
    If Range("o" & i) = "" Then 'Si aucun mail n'a été envoyé alors on lance la recherche sur la date
 
    If Range("h" & i) <> "" And Range("i" & i) <> "" And Now() > Range("i" & i) Then ' Si la cellule de date prêt n'est pas vide et que la date de retour est arrivée à expiration alors envoyer le mail
 
    adresse = Range("g" & i) 'Recherche l'adresse mail du destinataire
    ' Définition du message
    message = "Bonjour " & Range("e" & i) & "," & vbCrLf & vbCrLf & "Un " & Range("a" & i) & " " & _
    Range("b" & i) & " " & "ayant pour IMEI " & Range("c" & i) & " " & "t'a été prêté le " & _
    Range("h" & i) & ". " & "La période de prêt étant arrivée à échéance, merci de bien vouloir nous le rapporter, ou à défaut, me contacter." & _
    vbCrLf & vbCrLf & "Bien cordialement," & vbCrLf
 
    'Paramètres de l'application mail
    Set OutlookApp = CreateObject("outlook.application")
    Set OutlookMail = OutlookApp.createitem(0)
    With OutlookMail
    .Subject = sujet
    .To = adresse
    .body = message
    .send 'envoi du mail
 
    Range("o" & i).Value = Now 'lorsqu'un mail a été enovyé, la cellule en i est remplie avec la date d'envoi du mail afin d'éviter l'envoi de plusieurs mails
 
    End With
 
    End If
    End If
    Next i
 
 
    End Sub

Merci d'avance pour votre aide.
Bien cordialement,
mdb008