Discussion :

[icebergartist]

Bonjour,

je suis débutant sur VBA et je fais une macro sur excel qui permet de créer des comptes utilisateur. Cependant j'ai un problème avec l'envoi du mail de confirmation lors de la création du compte et sur le "mot de passe oublié". Voici mon code.
La première fois que j'ai lancé la macro on ma demander de configurer le mail, j'ai donc créé un mail outlook.fr pour envoyer les mail. Des fois ça fonctionne bien sauf que outlook semble considérer mes mails comme des spam est les bloque dans la boite de réception. A la fin du message je vous montre une capture écran de ce que j'ai sur ce mail outlook.fr.
Auriez vous une solution à ce problème? merci

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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
Option Explicit
 
Private Sub creationcompte_Click()
 
Dim user As String ' c'est le nom d'utilisateur
Dim mdp As String   ' c'est le mot de passe
Dim confirmation As String ' c'est le mot de passe entré pour confirmation
Dim mail As Variant ' sert à l'envoi du mail
Dim email As String ' email de l'utilisateur
Dim sendmail As Outlook.Application ' sert à l'envoi du mail
Dim createsheet As Worksheet ' sert à l'envoi du mail
Dim i As Long
 
Set sendmail = New Outlook.Application ' sert à l'envoi du mail
Set mail = sendmail.CreateItem(olMailItem) ' sert à l'envoi du mail
 
user = Me.textuser ' les variable prennent les valeurs entrées par l'utilisateur
mdp = Me.textmdp
confirmation = Me.textconf
email = Me.Textemail
 
If Range("user").Offset(1) <> "" Then
 
    For i = 1 To Range("user").End(xlDown).Row - 1 'on cherche si le nom d'utilisateur existe déjà
 
        If user = Range("user").Offset(i).Value Then 'si le nom d'utilisateur existe alors le message d'erreur s'affiche
 
            Me.msgerreur.Caption = "Nom d'utilisateur déjà utilisé"
            Me.msgerreur.Visible = True
            Me.textuser = "" ' on vide la textbox
            Exit Sub
 
        ElseIf email = Range("user").Offset(i, 2).Value Then 'on regarde si le mail existe déjà
 
            Me.msgerreur.Caption = "Email déjà enregistré"
            Me.msgerreur.Visible = True
            Me.Textemail = "" ' on vide la textbox
            Exit Sub
 
        End If
 
    Next i
End If
 
If mdp = "" Or user = "" Or confirmation = "" Or email = "" Then ' gestion d'erreur, il faut remplir tout l'userform
 
    Me.msgerreur.Visible = True
    Me.msgerreur.Caption = "Veuillez remplir toutes les informations"
 
ElseIf mdp <> confirmation Then ' gestion d'erreur du mot de passe
 
    Me.msgerreur.Visible = True
    Me.msgerreur.Caption = "Vous n'avez pas saisi le même mot de passe"
    Me.textconf = "" 'on vide les textbox
    Me.textmdp = ""
 
Else
    If MsgBox("Confirmez la création du compte", vbYesNo, "confirmation") = vbYes Then
     ' msgbox de confirmation de création du compte
        If Range("user").Offset(1).Value = "" Then
            ' on note les données dans la feuille connexion, ici c'est dans le cas où c'est le premier compte créé
            Range("user").Offset(1).Value = user
            Range("user").Offset(1, 1).Value = mdp
            Range("user").Offset(1, 2).Value = email
            MsgBox ("compte créé")
 
            Set createsheet = Sheets.Add(after:=Sheets(Sheets.Count)) 'création d'un nouvelle feuille pour ce nouveau compte
            createsheet.Name = "base de donnée " & user 'le nom de la feuille prend le nom "base de donné " suivit du nom d'utilisateur
 
            ThisWorkbook.Save
 
            On Error GoTo erreurmail
            With mail 'pour l'envoi du mail
                .To = email ' le destinataire
               .Subject = "Merci d'avoir créé votre compte"          ' l'objet du mail
               .Body = " Merci pour votre inscription, veuillez trouvez ci-dessous vos identifiants de connexion " & Chr(10) & " nom d'utilisateur: " & user & _
                        Chr(10) & "mot de passe: " & mdp 'le corps du mail ..son contenu
               .Send ' l'envoie du mail
            End With
            sendmail.Quit
            Set mail = Nothing
            Set sendmail = Nothing
 
            MsgBox ("Merci de votre inscription, vous recevrez un email dans quelques minutes")
 
            Unload Me 'on décharge l'userform pour libérer de la mémoire
 
 
 
        Else
            'si un compte existe déjà alors on note les données en dessous sur la feuille connexion
            Range("user").End(xlDown).Offset(1).Value = user
            Range("user").End(xlDown).Offset(0, 1).Value = mdp
            Range("user").End(xlDown).Offset(0, 2).Value = email
            MsgBox ("compte créé")
 
            Set createsheet = Sheets.Add(after:=Sheets(Sheets.Count)) 'création d'un nouvelle feuille pour ce nouveau compte
            createsheet.Name = "base de donnée " & user 'le nom de la feuille prend le nom "base de donné " suivit du nom d'utilisateur
 
            ThisWorkbook.Save
 
            On Error GoTo erreurmail
            With mail 'pour l'envoi du mail
                .To = email ' le destinataire
               .Subject = "Merci d'avoir créé votre compte"          ' l'objet du mail
               .Body = " Merci pour votre inscription, veuillez trouvez ci-dessous vos identifiants de connexion " & Chr(10) & " nom d'utilisateur: " & user & _
                        Chr(10) & "mot de passe: " & mdp 'le corps du mail ..son contenu
               .Send ' l'envoie du mail
            End With
            sendmail.Quit
            Set mail = Nothing
            Set sendmail = Nothing
 
            MsgBox ("Merci de votre inscription, vous recevrez un email dans quelques minutes")
 
            Unload Me 'on décharge l'userform pour libérer de la mémoire
 
 
 
        End If
 
    Else
 
        Unload Me 'on décharge l'userform pour libérer la mémoire si il choisi non pour la confirmation de création du compte
 
    End If
 
End If
 
Exit Sub
 
erreurmail:
    MsgBox ("compte crée mais erreur dans l'envoie de mail, vérifier votre connexion internet")
    Unload Me 'on décharge l'userform pour libérer de la mémoire
 
End Sub