Discussion :

[jeremV]

Bonjour je désire envoyer un mail lorsque j'ai mes checkbox 1 à 5 qui sont coché mais le probleme c'est que j'essai desesperement cette macro trouvé sur le net mais elle ne fonctionne pas est ce que quelqu'un pourait m'aider svp bon bien sur avec mes donnée personnelle qui ne sont pas dedans

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
Private Sub envoiCdo()
    On Error GoTo Error_send
    Dim oCdo As Object
 
    Set oCdo = CreateObject("CDO.Message")
 
    With oCdo
        With .Configuration.Fields
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.fr.oleane.com" 'nom ou IP du serveur SMTP
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = "25" 'port utilisé 
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mon nom de connexion qui est correcte"          
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mon mdp qui est correcte"                  
.Update
 
        End With
        .Subject = "envoi exemple"                    ' objet du message
        .From = "monemail@truc.com"                ' adresse de l'expéditeur
        .To = "monemail@truc.com"                  ' adresse du destinataire
        .TextBody = "Ceci est un message de test."    ' corps du message en format texte brut
        .Send
 
    End With
 
Fin:
    Set oCdo = Nothing
    Exit Sub
 
Error_send:
    MsgBox "Erreur d'envoi " & Err.Number & "  " & Err.Description
    Resume Fin
 
End Sub

[Invité]

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
 
Public Function MailEnvoi(Serveur, Identify, SSL, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, DestEnCah, Objet, Body, Pj)
On Error GoTo Fin
MailEnvoi = True
Dim Log
 
' sub pour envoyer les mails
Dim msg
Dim Conf
Dim Config
Dim ess
Dim splitPj
Dim IsplitPj
Dim schema
Const cdoBasic = 1
Dim Erreur
Dim Sql
Set msg = CreateObject("CDO.Message") 'pour la configuration du message
Set Conf = CreateObject("CDO.Configuration") '  pour la configuration de l'envoi
Dim strHTML
 
Set Config = Conf.Fields
 
' Configuration des parametres d'envoi
'(SMTP - Identification - SSL - Password - Nom Utilisateur - Adresse messagerie)
schema = "http://schemas.microsoft.com/cdo/configuration/" 'smtpusessl
With Config
 
If Identify <> 0 Then
    .Item(schema & "smtpusessl") = SSL
    .Item(schema & "smtpusetls") = 1
    .Item(schema & "smtpauthenticate") = Identify
    .Item(schema & "sendusername") = User
    .Item(schema & "sendpassword") = PassWord
End If
    .Item(schema & "smtpserverport") = Port
    .Item(schema & "sendusing") = 2
    .Item(schema & "smtpserver") = Serveur
    .Item(schema & "smtpconnectiontimeout") = Delay
    .Item(schema & "enablessl") = 1
 
    .Update
End With
'Configuration du message
'If E_mail.Sign.Value = Checked Then Convert ServeurFrm.SignTXT, ServeurFrm.Text1
 
With msg
    Set .Configuration = Conf
 
    .To = Dest
    .cc = DestEnCopy
    .bcc = Expediteur & DestEnCah
    .FROM = Expediteur
    .Subject = Objet
'   .DSNOptions = cdoDSN
'
 
    .htmlbody = Replace(Replace(Body, Chr(13), "", 1, -1), Chr(10), "<br>", 1, -1) '"<p align=""center""><font face=""Verdana"" size=""1"" color=""#9224FF""><b><br><font face=""Comic Sans MS"" size=""5"" color=""#FF0000""></b><i>" & body & "</i></font> " 'E_mail.ZThtml.Text
            If Pj <> "" Then
        splitPj = Split(Pj & ";", ";")
 
        For IsplitPj = 0 To UBound(splitPj)
            If Trim("" & splitPj(IsplitPj)) <> "" Then
                .AddAttachment Trim("" & splitPj(IsplitPj))
            End If
        Next
 
    End If
 
    .Send 'envoi du message
 
On Error GoTo 0
End With
Exit Sub
Fin:
 MsgBox Err.Description
End Function
Sub test()
Dim Serveur
Dim Identify
Dim SSL
Dim User
Dim PassWord
Dim Port
Dim Delay
Dim Expediteur
Dim Dest
Dim DestEnCopy
Dim DestEnCah
Dim Objet
Dim Body
Dim Pj
    Serveur = "192.168..."
   Identify = 0
   SSL = False
   User = "Moi"
   PassWord = "1234"
   Port = 25
   Delay = 10
   Expediteur = "moi@orange.fr"
   Dest = "toi@free.fr"
   DestEnCopy = "lui@gmail.com"
   DestEnCah "bof@yahooe.fr"
   Objet = "je vous..."
   Body = "les senglo lon de violons de l'otonne!"
   Pj = "c:\myrep\myfichier.xls"
MailEnvoi Serveur, Identify, SSL, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, DestEnCah, Objet, Body, Pj
End Sub

[jeremV]

Merci pour la reponse :p par contre je doit remplir quel partie svp ?

[Invité]

regarde la sub test

[jeremV]

Par contre je dois le mettre ou dans la programmation pour l'activer d'un bouton activeX svp. Concernant l'adresse ip je la trouve ou ? il n'y a pas que sub test a changé je me trompe ?

[Invité]

non rien ça marche dans l’état. je l'ai créé pour du VBSCRIPT et là il n'y a pas la notion de références.